first commit
This commit is contained in:
commit
d12ffc4f58
1 changed files with 114 additions and 0 deletions
114
y.hs
Normal file
114
y.hs
Normal file
|
@ -0,0 +1,114 @@
|
|||
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))
|
Loading…
Reference in a new issue