app/Main.hs

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