48時間でSchemeを書こう/練習問題の解答
練習問題1[編集]
-
import System main :: IO () main = do args <- getArgs putStrLn ("Hello, " ++ args !! 0 ++ " " ++ args !! 1)
-
import System main :: IO () main = do args <- getArgs print $ (read $ args !! 0) + (read $ args !! 1)
$演算子によって括弧の数を減らしています。最後の行は$を使わずにprint ((read (args !! 0)) + (read $ args !! 1))とも書けます。 -
import System main :: IO () main = do putStrLn "お名前は?" name <- getLine putStrLn $ "あなたの名前は" ++ name ++ "ですね!"
練習問題2[編集]
-
-
parseNumber :: Parser LispVal parseNumber = do x <- many1 digit return $ Number $ read x
-
parseNumber = many1 digit >>= return . Number . read
-
-
まず、バックスラッシュにバックスラッシュか二重引用符が続いた文字列を認識し、バックスラッシュか二重引用符それ自身を返すパーサアクションを作ります。
escapedChars :: Parser Char escapedChars = do char '\\' -- バックスラッシュ x <- oneOf "\\\"" -- バックスラッシュまたは二重引用符 return x -- エスケープされた文字を返す
またはもっと簡潔に
escapedChars = char '\\' >> oneOf "\\\""
これを使うよう
parseStringも変更します。parseString :: Parser LispVal parseString = do char '"' x <- many $ escapedChars <|> noneOf "\"\\" char '"' return $ String x
-
escapedChars :: Parser Char escapedChars = do x <- char '\\' >> oneOf "\\\"nrt" return $ case x of 'n' -> '\n' 'r' -> '\r' 't' -> '\t' _ -> x
-
First, it is necessary to change the definition of symbol.
symbol :: Parser Char symbol = oneOf "!$%&|*+-/:<=>?@^_~"
This means that it is no longer possible to begin an atom with the hash character. This necessitates a different way of parsing #t and #f.
parseBool :: Parser LispVal parseBool = do string "#" x <- oneOf "tf" return $ case x of 't' -> Bool True 'f' -> Bool False
This in turn requires us to make changes to parseExpr.
parseExpr :: Parser LispVal parseExpr = parseAtom <|> parseString <|> parseNumber <|> parseBool
parseNumber need to be changed to the following.
parseNumber :: Parser LispVal parseNumber = do num <- parseDigital1 <|> parseDigital2 <|> parseHex <|> parseOct <|> parseBin return $ num
And the following new functions need to be added.
parseDigital1 :: Parser LispVal parseDigital1 = do x <- many1 digit (return . Number . read) x parseDigital2 :: Parser LispVal parseDigital2 = do try $ string "#d" x <- many1 digit (return . Number . read) x parseHex :: Parser LispVal parseHex = do try $ string "#x" x <- many1 hexDigit return $ Number (hex2dig x) parseOct :: Parser LispVal parseOct = do try $ string "#o" x <- many1 octDigit return $ Number (oct2dig x) parseBin :: Parser LispVal parseBin = do try $ string "#b" x <- many1 (oneOf "10") return $ Number (bin2dig x) oct2dig x = fst $ readOct x !! 0 hex2dig x = fst $ readHex x !! 0 bin2dig = bin2dig' 0 bin2dig' digint "" = digint bin2dig' digint (x:xs) = let old = 2 * digint + (if x == '0' then 0 else 1) in bin2dig' old xs
-
data LispVal = Atom String | List [LispVal] | DottedList [LispVal] LispVal | Number Integer | String String | Bool Bool | Character Char parseCharacter :: Parser LispVal parseCharacter = do try $ string "#\\" value <- try (string "newline" <|> string "space") <|> do { x <- anyChar; notFollowedBy alphaNum ; return [x] } return $ Character $ case value of "space" -> ' ' "newline" -> '\n' otherwise -> (value !! 0)
The combination of anyChar and notFollowedBy ensure that only a single character is read.
Note that this does not actually conform to the standard; as it stands, "space" and "newline" must be entirely lowercase; the standard states that they should be case insensitive.
parseExpr :: Parser LispVal parseExpr = parseAtom <|> parseString <|> try parseNumber -- we need the 'try' because <|> try parseBool -- these can all start with the hash char <|> try parseCharacter
-
A possible solution for floating point numbers:
parseFloat :: Parser LispVal parseFloat = do x <- many1 digit char '.' y <- many1 digit return $ Float (fst.head$readFloat (x++"."++y))
Furthermore, add
try parseFloat
before parseNumber in parseExpr and the line
| Float Double
to the LispVal type.
-
Ratio, using Haskell's Ratio type:
parseRatio :: Parser LispVal parseRatio = do x <- many1 digit char '/' y <- many1 digit return $ Ratio ((read x) % (read y))
Additionally, import the Ratio module, add
try parseRatio
before parseNumber in parseExpr and the line
| Ratio Rational
to the LispVal type.
Real is already implemented in the Float type from Exercise 6, unless I'm mistaken.
Complex using Haskell's Complex type:
toDouble :: LispVal -> Double toDouble(Float f) = f toDouble(Number n) = fromIntegral n parseComplex :: Parser LispVal parseComplex = do x <- (try parseFloat <|> parseDecimal) char '+' y <- (try parseFloat <|> parseDecimal) char 'i' return $ Complex (toDouble x :+ toDouble y)
As before, import the Complex module, add
try parseComplex
before parseNumber and parseFloat in parseExpr and the line
| Complex (Complex Double)
to the LispVal type.
Section 4 - Recursive Parsers: Adding lists, dotted lists, and quoted datums[編集]
Exercise 1[編集]
These two are analogous to parseQuoted:
parseQuasiQuoted :: Parser LispVal
parseQuasiQuoted = do
char '`'
x <- parseExpr
return $ List [Atom "quasiquote", x]
parseUnQuote :: Parser LispVal
parseUnQuote = do
char ','
x <- parseExpr
return $ List [Atom "unquote", x]
Also add
<|> parseQuasiQuoted
<|> parseUnQuote
to parseExpr.
Exercise 2[編集]
I chose to go with Arrays as described in Data.Array and used list-array conversions for array construction.
parseVector :: Parser LispVal
parseVector = do arrayValues <- sepBy parseExpr spaces
return $ Vector (listArray (0,(length arrayValues - 1)) arrayValues)
In order to use this,
import ''Data.Array''
and add the following to the LispVal type:
| Vector (Array Int LispVal)
Add the following lines to parseExpr; before the parser for Lists and DottedLists.
<|> try (do string "#("
x <- parseVector
char ')'
return x)
Exercise 3[編集]
This took a fair amount of fiddling with sepBy, endBy and friends. I started by getting the (. degenerate) dotted list to work and then went from there. This code tolerates trailing and leading spaces.
parseAnyList :: Parser LispVal
parseAnyList = do
P.char '('
optionalSpaces
head <- P.sepEndBy parseExpr spaces
tail <- (P.char '.' >> spaces >> parseExpr) <|> return (Nil ())
optionalSpaces
P.char ')'
return $ case tail of
(Nil ()) -> List head
otherwise -> DottedList head tail
Alternative solution without a Nil constructor. spaces is the spaces from Parsec and spaces1 is the spaces from this tutorial.
parseList :: Parser LispVal
parseList = do char '(' >> spaces
head <- parseExpr `sepEndBy` spaces1
do char '.' >> spaces1
tail <- parseExpr
spaces >> char ')'
return $ DottedList head tail
<|> (spaces >> char ')' >> (return $ List head))
Chapter 3[編集]
Exercise 1[編集]
Here is one way of adding a few of them.
primitives :: [(String , [LispVal] -> LispVal)]
primitives = [("+" , numericBinop (+)) ,
("-" , numericBinop (-)) ,
("*" , numericBinop (*)) ,
("/" , numericBinop div) ,
("mod" , numericBinop mod) ,
("quotient" , numericBinop quot) ,
("remainder" , numericBinop rem) ,
("symbol?" , unaryOp symbolp) ,
("string?" , unaryOp stringp) ,
("number?" , unaryOp numberp) ,
("bool?", unaryOp boolp) ,
("list?" , unaryOp listp)]
unaryOp :: (LispVal -> LispVal) -> [LispVal] -> LispVal
unaryOp f [v] = f v
symbolp, numberp, stringp, boolp, listp :: LispVal -> LispVal
symbolp (Atom _) = Bool True
symbolp _ = Bool False
numberp (Number _) = Bool True
numberp _ = Bool False
stringp (String _) = Bool True
stringp _ = Bool False
boolp (Bool _) = Bool True
boolp _ = Bool False
listp (List _) = Bool True
listp (DottedList _ _) = Bool True
listp _ = Bool False
Exercise 2[編集]
unpackNum :: LispVal -> Integer
unpackNum (Number n) = n
unpackNum _ = 0
Exercise 3[編集]
Add symbol->string and string->symbol to the list of primitives, then:
symbol2string, string2symbol :: LispVal -> LispVal
symbol2string (Atom s) = String s
symbol2string _ = String ""
string2symbol (String s) = Atom s
string2symbol _ = Atom ""
This doesn't deal well with bad input, which is covered later.
Chapter 5[編集]
Exercise 1[編集]
eval env (List [Atom "if", pred, conseq, alt]) = do
result <- eval env pred
case result of
Bool False -> eval env alt
Bool True -> eval env conseq
_ -> throwError $ TypeMismatch "bool" pred
Exercise 2[編集]
Define a helper function that takes the equal/eqv function as an argument:
eqvList :: ([LispVal] -> ThrowsError LispVal) -> [LispVal] -> ThrowsError LispVal
eqvList eqvFunc [(List arg1), (List arg2)] = return $ Bool $ (length arg1 == length arg2) &&
(all eqvPair $ zip arg1 arg2)
where eqvPair (x1, x2) = case eqvFunc [x1, x2] of
Left err -> False
Right (Bool val) -> val
Now adjust the eqv clause:
eqv [l1@(List arg1), l2@(List arg2)] = eqvList eqv [l1, l2]
And add clauses for List and DottedList to the equal function:
equal :: [LispVal] -> ThrowsError LispVal
equal [l1@(List arg1), l2@(List arg2)] = eqvList equal [l1, l2]
equal [(DottedList xs x), (DottedList ys y)] = equal [List $ xs ++ [x], List $ ys ++ [y]]
equal [arg1, arg2] = do
primitiveEquals <- liftM or $ mapM (unpackEquals arg1 arg2)
[AnyUnpacker unpackNum, AnyUnpacker unpackStr, AnyUnpacker unpackBool]
eqvEquals <- eqv [arg1, arg2]
return $ Bool $ (primitiveEquals || let (Bool x) = eqvEquals in x)
equal badArgList = throwError $ NumArgs 2 badArgList
Exercise 3[編集]
cond[編集]
Room for improvement here!
eval (List ((Atom "cond"):cs)) = do
b <- (liftM (take 1 . dropWhile f) $ mapM condClause cs) >>= cdr
car [b] >>= eval
where condClause (List [p,b]) = do q <- eval p
case q of
Bool _ -> return $ List [q,b]
_ -> throwError $ TypeMismatch "bool" q
condClause v = throwError $ TypeMismatch "(pred body)" v
f = \(List [p,b]) -> case p of
(Bool False) -> True
_ -> False
Another approach:
eval env (List (Atom "cond" : expr : rest)) = do
eval' expr rest
where eval' (List [cond, value]) (x : xs) = do
result <- eval env cond
case result of
Bool False -> eval' x xs
Bool True -> eval env value
otherwise -> throwError $ TypeMismatch "boolean" cond
eval' (List [Atom "else", value]) [] = do
eval env value
eval' (List [cond, value]) [] = do
result <- eval env cond
case result of
Bool True -> eval env value
otherwise -> throwError $ TypeMismatch "boolean" cond