「Write Yourself a Scheme in 48 Hours」と言うHaskellでSchemeを書くチュートリアルを見つけたので、理解出来るとこまで写経してみます。
1.First Steps: Compiling and running
2.Parsing
parsec によるパース
-- spaces を自分で定義しているので Parsec の spaces は隠している。 import Text.ParserCombinators.Parsec hiding (spaces) symbol :: Parser Char symbol = oneOf "!#$%&|*+-/:<=>?@^_~" readExpr :: String -> String readExpr input = case parse symbol "lisp" input of Left err -> "No match: " ++ show err Right val -> "Found value" main :: IO () main = do args <- getArgs putStrLn (readExpr (args !! 0))
symbolの文字にだけマッチして他は失敗。
[1 of 1] Compiling Main ( lisp1.hs, interpreted ) Ok, modules loaded: Main. *Main> putStrLn $ readExpr "$" Loading package syb-0.1.0.2 ... linking ... done. Loading package base-3.0.3.2 ... linking ... done. Loading package parsec-2.1.0.1 ... linking ... done. Found value *Main> putStrLn $ readExpr "<" Found value *Main> putStrLn $ readExpr "a" No match: "lisp" (line 1, column 1): unexpected "a"
-- spaces 関数を追加 spaces :: Parser () spaces = skipMany1 space -- readExpr 関数の適用する関数 symbol を (spaces >> symbol) に修正。 readExpr input = case parse (spaces >> symbol) "lisp" input of Left err -> "No match: " ++ show err Right val -> "Found value"
(spaces >> symbol) はパッと見た感じだと「">>" がモナドなので spaces を適用して結果を捨てて、symbolを適用しそう。
*Main> putStrLn $ readExpr " *" Found value *Main> putStrLn $ readExpr " a" No match: "lisp" (line 1, column 8): unexpected "a" expecting space
スペースを読み飛ばしている。
パースした結果、数字は数字に、文字列は文字列として意味を持たせてリストに格納する必要があります。
module Main where import Control.Monad import System.Environment import Text.ParserCombinators.Parsec hiding (spaces) data LispVal = Atom String -- アトムは名前 | List [LispVal] -- リストはリスト | DottedList [LispVal] LispVal -- ドットリスト (a b . c) | Number Integer | String String | Bool Bool symbol :: Parser Char symbol = oneOf "!#$%&|*+-/:<=>?@^_~" spaces :: Parser () spaces = skipMany1 space parseString :: Parser LispVal parseString = do char '"' x <- many (noneOf "\"") char '"' return $ String x parseNumber :: Parser LispVal parseNumber = liftM (Number . read) $ many1 digit parseAtom :: Parser LispVal parseAtom = do first <- letter <|> symbol rest <- many (letter <|> digit <|> symbol) let atom = first:rest -- atom は first と rest のリスト return $ case atom of "#t" -> Bool True "#f" -> Bool False _ -> Atom atom 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 readExpr :: String -> String readExpr input = case parse parseExpr "lisp" input of Left err -> "No match: " ++ show err Right _ -> "Found value" main :: IO () main = do args <- getArgs putStrLn (readExpr (args !! 0))
*Main> putStrLn $ readExpr "(a #t)" Found value *Main> putStrLn $ readExpr "(a 123)" Found value *Main> putStrLn $ readExpr "(12 123)" Found value *Main> putStrLn $ readExpr "(a (nested) test)" Found value *Main> putStrLn $ readExpr "(a (dotted . list) test)" Found value *Main> putStrLn $ readExpr "(a '(quoted (dotted . list)) test)" Found value
-- http://jonathan.tang.name/files/scheme_in_48/code/listing3.4.hs module Main where import Monad import System.Environment import Text.ParserCombinators.Parsec hiding (spaces) main :: IO () main = do args <- getArgs putStrLn (readExpr (args !! 0)) symbol :: Parser Char symbol = oneOf "!$%&|*+-/:<=>?@^_~#" 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 -- 表示するために 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 {- > 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
> parseTest parseString "\"hello\"" -- > String "hello" > parseTest parseAtom "a" -- > Atom "a" > parseTest parseAtom "#f" -- > Bool False > parseTest parseAtom "#t" -- > Bool True > parseTest parseNumber "123" -- > Number 123 > parseTest parseNumber "123.4" -- > Number 123 > parseTest parseExpr "(a (dotted . list) 123)" -- > List [Atom "a",DottedList [Atom "dotted"] (Atom "list"),Number 123] > parseTest parseExpr "(a (dotted . list) '(abc (46 t)))" -- > List [Atom "a",DottedList [Atom "dotted"] (Atom "list"),\ \List [Atom "quote",List [Atom "abc",List [Number 46,Atom "t"]]]]
Parsing はここまで。
まとまったコードはこちらにあります。Index of /files/scheme_in_48/code