48時間でSchemeを書こう/練習問題の解答

出典: フリー教科書『ウィキブックス(Wikibooks)』
Jump to navigation Jump to search

練習問題1[編集]

  1. import System
    
    main :: IO ()
    main = do args <- getArgs
              putStrLn ("Hello, " ++ args !! 0 ++ " " ++ args !! 1)
    
  2. import System
    
    main :: IO ()
    main = do args <- getArgs
              print $ (read $ args !! 0) + (read $ args !! 1)
    

    $演算子によって括弧の数を減らしています。最後の行は$を使わずにprint ((read (args !! 0)) + (read $ args !! 1))とも書けます。

  3. import System
    
    main :: IO ()
    main = do putStrLn "お名前は?"
              name <- getLine
              putStrLn $ "あなたの名前は" ++ name ++ "ですね!"
    

練習問題2[編集]

    1. parseNumber :: Parser LispVal
      parseNumber = do x <- many1 digit
                       return $ Number $ read x
      
    2. parseNumber = many1 digit >>= return . Number . read
      
  1. まず、バックスラッシュにバックスラッシュか二重引用符が続いた文字列を認識し、バックスラッシュか二重引用符それ自身を返すパーサアクションを作ります。
    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
    
  2. escapedChars :: Parser Char
    escapedChars = do x <- char '\\' >> oneOf "\\\"nrt"
                      return $ case x of
                        'n' -> '\n'
                        'r' -> '\r'
                        't' -> '\t'
                        _ -> x
    
  3. 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
    
  4.  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
    
  5. 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.

  6. 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

Exercise 4[編集]