app/Main.hs

   1 module Main where
   2 import Control.Monad
   3 import Text.ParserCombinators.Parsec hiding (spaces)
   4 import System.Environment
   5
   6 data LispVal = Atom String
   7              | List [LispVal]
   8              | DottedList [LispVal] LispVal
   9              | Number Integer
  10              | String String
  11              | Bool Bool
  12              deriving Show
  13
  14 symbol :: Parser Char
  15 symbol = oneOf "!#$%&|*+-/:<=>?@^_~"
  16
  17 spaces :: Parser ()
  18 spaces = skipMany space
  19
  20 parseString :: Parser LispVal
  21 parseString = do char '"'
  22                  x <- many innerChar
  23                  char '"'
  24                  return $ String x
  25               where innerChar = noneOf ['\\', '\"'] <|> escapeChar
  26                     escapeChar = do char '\\'
  27                                     c <- oneOf ['\"', '\\', 'n', 'r', 't', 'f']
  28                                     return $ case c of
  29                                                 '\"' -> '\"'
  30                                                 '\\' -> '\\'
  31                                                 'n'  -> '\n'
  32                                                 'r'  -> '\r'
  33                                                 't'  -> '\t'
  34                                                 'f'  -> '\f'
  35
  36 parseAtom :: Parser LispVal
  37 parseAtom = do
  38     a <- letter <|> symbol
  39     b <- many (letter <|> digit <|> symbol)
  40     let atom = a:b
  41     return $ case atom of
  42                 "#t" -> Bool True
  43                 "#f" -> Bool False
  44                 _    -> Atom atom
  45
  46 parseNumber :: Parser LispVal
  47 parseNumber = do ds <- many1 digit
  48                  let a = read ds
  49                  return $ Number a
  50
  51 parseExpr :: Parser LispVal
  52 parseExpr = parseString
  53         <|> parseAtom
  54         <|> parseNumber
  55
  56 readExpr :: String -> String
  57 readExpr input = case parse parseExpr "lisp" input of
  58     Left err -> "No match: " ++ show err
  59     Right val -> "Found value: " ++ show val
  60
  61 main :: IO ()
  62 main = do
  63     args <- getLine
  64     putStrLn (readExpr args)
  65     main