114 lines
3.4 KiB
Haskell
114 lines
3.4 KiB
Haskell
module Main where
|
|
|
|
import Data.List (foldl')
|
|
import Text.ParserCombinators.Parsec hiding (spaces)
|
|
import System.Environment (getArgs)
|
|
|
|
data LispVal = Atom String
|
|
| List [LispVal]
|
|
| DottedList [LispVal] LispVal
|
|
| Number Integer
|
|
| String String
|
|
| Bool Bool
|
|
deriving (Show)
|
|
|
|
symbol :: Parser Char
|
|
symbol = oneOf "!#$%&|*+-/:<=>?@^_~"
|
|
|
|
spaces :: Parser ()
|
|
spaces = skipMany1 space
|
|
|
|
parseString :: Parser LispVal
|
|
parseString = do
|
|
char '"'
|
|
x <- many ( (char '\\' >> char 'n' >> return '\n')
|
|
<|> (char '\\' >> char 'r' >> return '\r')
|
|
<|> (char '\\' >> char 't' >> return '\t')
|
|
<|> (char '\\' >> anyChar)
|
|
<|> 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
|
|
"#vrai" -> Bool True
|
|
"#faux" -> Bool False
|
|
_ -> Atom atom
|
|
|
|
numFromBase n str = foldl' traiteNombre 0 str
|
|
where
|
|
traiteNombre acc v = acc*n + chiffre
|
|
where chiffre = case v of
|
|
'0' -> 0
|
|
'1' -> 1
|
|
'2' -> 2
|
|
'3' -> 3
|
|
'4' -> 4
|
|
'5' -> 5
|
|
'6' -> 6
|
|
'7' -> 7
|
|
'8' -> 8
|
|
'9' -> 9
|
|
'A' -> 10
|
|
'B' -> 11
|
|
'C' -> 12
|
|
'D' -> 13
|
|
'E' -> 14
|
|
'F' -> 15
|
|
'a' -> 10
|
|
'b' -> 11
|
|
'c' -> 12
|
|
'd' -> 13
|
|
'e' -> 14
|
|
'f' -> 15
|
|
|
|
parseBaseSpecifiedNumber :: Parser Integer
|
|
parseBaseSpecifiedNumber = do
|
|
_ <- char '#'
|
|
numtype <- oneOf "bdox"
|
|
(base,str) <- case numtype of
|
|
'b' -> do
|
|
numstr <- many1 (oneOf "01")
|
|
return (2,numstr)
|
|
'o' -> do
|
|
numstr <- many1 (oneOf "01234567")
|
|
return (8,numstr)
|
|
'd' -> do
|
|
numstr <- many1 (oneOf "0123456789")
|
|
return (10,numstr)
|
|
'x' -> do
|
|
numstr <- many1 (oneOf "0123456789ABCDEFabcdef")
|
|
return (16,numstr)
|
|
return $ numFromBase base str
|
|
|
|
parseSimpleNumber :: Parser Integer
|
|
parseSimpleNumber = do
|
|
numStr <- many1 digit
|
|
return (read numStr)
|
|
|
|
parseNumber :: Parser LispVal
|
|
parseNumber = do
|
|
number <- parseSimpleNumber
|
|
<|> parseBaseSpecifiedNumber
|
|
return (Number number)
|
|
|
|
parseExpr :: Parser LispVal
|
|
parseExpr = parseString
|
|
<|> parseNumber
|
|
<|> parseAtom
|
|
|
|
|
|
readExpr :: String -> String
|
|
readExpr input = case parse parseExpr "lisp" input of
|
|
Left err -> "No match: " ++ show err
|
|
Right val -> show val
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
putStrLn (readExpr (args !!0))
|