this is a tutorial of writing scheme in haskell
module Main where
import Data.Complex
import Data.Ratio
import Numeric
import Control.Monad
import System.Environment
import Text.Parsec hiding (spaces)
import Text.Parsec.String
main :: IO ()
main = do args <- getLine
putStrLn (readExpr ([args] !! 0))
symbol :: Parser Char
symbol = oneOf "!$%&|*+-/:<=>?@^_~"
readExpr :: String -> String
readExpr input = case parse parseExpr "lisp" input of
Left err -> "No match: " ++ show err
Right val -> "Found value"
spaces :: Parser ()
spaces = skipMany1 space
toDouble :: LispVal -> Double
toDouble(Float f) = f
toDouble(Number n) = fromIntegral n
data LispVal = Atom String
| List [LispVal]
| DottedList [LispVal] LispVal
| Number Integer
| String String
| Bool Bool
| Character Char
| Float Double
| Ratio Rational
| Complex (Complex Double)
escapedChars :: Parser Char
escapedChars = do char '\\' -- a backslash
x <- oneOf "\\\"nrt" -- either backslash or doublequote or n,r, or t
return $ case x of -- return the escaped character
'\\' -> x
'"' -> x
'n' ->'\n'
'r' ->'\r'
't' ->'\t'
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)
parseBool :: Parser LispVal
parseBool = do char '#'
(char 't' >> return (Bool True)) <|> (char 'f' >> return (Bool False))
parseString :: Parser LispVal
parseString = do char '"'
x <- many $ escapedChars <|> noneOf ['\34', '\92'] -- double-quote, backslash
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
"#t" -> Bool True
"#f" -> Bool False
otherwise -> Atom atom
--was used before parseDigital came along
--parseNumber :: Parser LispVal
--parseNumber = liftM (Number . read) $ many1 digit
--parseNumber = many1 digit >>= \x -> (return. Number. read) x
parseNumber :: Parser LispVal
parseNumber = parseDigital1 <|> parseDigital2 <|> parseHex <|> parseOct <|> parseBin
parseFloat :: Parser LispVal
parseFloat = do x <- many1 digit
char '.'
y <- many1 digit
return $ Float (fst.head $ readFloat (x ++ "." ++y))
parseComplex :: Parser LispVal
parseComplex = do x <- (try parseFloat <|> parseDigital1)
char '+'
y <- (try parseFloat <|> parseDigital1)
char 'i'
return $ Complex (toDouble x :+ toDouble y)
parseRatio :: Parser LispVal
parseRatio = do x <- many1 digit
char '/'
y <- many1 digit
return $ Ratio ((read x ) % (read y))
parseDigital1 :: Parser LispVal
parseDigital1 = many1 digit >>= (return . Number. read)
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
parseExpr ::Parser LispVal
parseExpr = parseAtom
<|> parseString
<|> parseRatio
<|> parseComplex
<|> parseFloat
<|> try parseNumber --we need try because they can all start with hash char
<|> try parseBool
<|> try parseCharacter