Browse Source

First commit (Error finished)

master
commit
8d534810b2
  1. 9
      listing2.hs
  2. 118
      listing3.hs
  3. 201
      scheme.hs

9
listing2.hs

@ -0,0 +1,9 @@
module Main where
import System.Environment
main :: IO ()
main = do
putStrLn "Enter your name: "
name <- getLine
putStrLn ("Hello, " ++ name)

118
listing3.hs

@ -0,0 +1,118 @@
import System.Environment
import Text.ParserCombinators.Parsec hiding (spaces)
import Control.Monad
import Numeric
-- Simple Parsers
symbol :: Parser Char
symbol = oneOf "!#$%&|*+-/:<=>?@^_~"
spaces :: Parser ()
spaces = skipMany1 space
data LispVal = Atom String
| List [LispVal]
| DottedList [LispVal] LispVal
| Number Integer
| String String
| Bool Bool
parseString :: Parser LispVal
parseString = do
char '"'
x <- many ( (char '\\' >> oneOf "\\n\"rt") <|> 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
"#t" -> Bool True
"#f" -> Bool False
_ -> Atom atom
recbin :: (Integral a) => a -> String -> a
recbin n [] = n
recbin n (x:l) = case x of
'0' -> recbin (n*2) l
'1' -> recbin (n*2 + 1) l
readBin :: (Integral a) => String -> a
readBin = recbin 0
parseSimpleNumber :: Parser LispVal
parseSimpleNumber = do
x <- many1 digit
return $ Number $ read x
parseSpecificNumber :: Parser LispVal
parseSpecificNumber = do
prefix <- char '#'
base <- oneOf "bodx"
x <- many1 digit
return $ case base of
'd' -> Number $ read x
'b' -> Number $ readBin x
'o' -> Number $ fst ( head ( readOct x ) )
'x' -> Number $ fst ( head ( readHex x ) )
parseNumber :: Parser LispVal
parseNumber = parseSpecificNumber <|> parseSimpleNumber
-- TODO
--
-- 5 Add a Character constructor to LispVal, and create a parser for character literals as described in R5RS.
-- [http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_sec_6.3.4]
--
-- 6 Add a Float constructor to LispVal, and support R5RS syntax for decimals. The Haskell function readFloat may be useful.
-- http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_sec_6.2.4
-- http://www.haskell.org/onlinereport/numeric.html#sect14
--
-- # Add data types and parsers to support the full numeric tower of Scheme numeric types. Haskell has built-in types to represent many of these; check the Prelude. For the others, you can define compound types that represent eg. a Rational as a numerator and denominator, or a Complex as a real and imaginary part (each itself a Real number).
-- http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_sec_6.2.1
-- http://www.haskell.org/onlinereport/standard-prelude.html#$tNum
-- Recursive Parser: Adding lists, dotted lists, and quoted datums
parseList :: Parser LispVal
parseList = liftM List $ sepBy parseExpr spaces
parseDottedList :: Parser LispVal
parseDottedList = do
head <- endBy parseExpr spaces
tail <- char '.' >> spaces >> parseExpr
return $ DottedList head tail
parseQuoted :: Parser LispVal
parseQuoted = do
char '\''
x <- parseExpr
return $ List [Atom "quote", x]
parseExpr :: Parser LispVal
parseExpr = parseAtom
<|> parseString
<|> parseNumber
<|> parseQuoted
<|> do
char '('
x <- try parseList <|> parseDottedList
char ')'
return x
-- Main
readExpr :: String -> String
readExpr input = case parse parseExpr "lisp" input of
Left err -> "No match: " ++ show err
Right _ -> "Found value"
main :: IO ()
main = do
args <- getArgs
putStrLn (readExpr (args !! 0))

201
scheme.hs

@ -0,0 +1,201 @@
import System.Environment
import Text.ParserCombinators.Parsec hiding (spaces)
import Control.Monad
import Control.Monad.Error
import Numeric
-- Simple Parsers
symbol :: Parser Char
symbol = oneOf "!#$%&|*+-/:<=>?@^_~"
spaces :: Parser ()
spaces = skipMany1 space
data LispVal = Atom String
| List [LispVal]
| DottedList [LispVal] LispVal
| Number Integer
| String String
| Bool Bool
parseString :: Parser LispVal
parseString = do
char '"'
x <- many ( (char '\\' >> oneOf "\\n\"rt") <|> 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
"#t" -> Bool True
"#f" -> Bool False
_ -> Atom atom
recbin :: (Integral a) => a -> String -> a
recbin n [] = n
recbin n (x:l) = case x of
'0' -> recbin (n*2) l
'1' -> recbin (n*2 + 1) l
readBin :: (Integral a) => String -> a
readBin = recbin 0
parseSimpleNumber :: Parser LispVal
parseSimpleNumber = do
x <- many1 digit
return $ Number $ read x
parseSpecificNumber :: Parser LispVal
parseSpecificNumber = do
prefix <- char '#'
base <- oneOf "bodx"
x <- many1 digit
return $ case base of
'd' -> Number $ read x
'b' -> Number $ readBin x
'o' -> Number $ fst ( head ( readOct x ) )
'x' -> Number $ fst ( head ( readHex x ) )
parseNumber :: Parser LispVal
parseNumber = parseSpecificNumber <|> parseSimpleNumber
-- TODO
--
-- 5 Add a Character constructor to LispVal, and create a parser for character literals as described in R5RS.
-- [http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_sec_6.3.4]
--
-- 6 Add a Float constructor to LispVal, and support R5RS syntax for decimals. The Haskell function readFloat may be useful.
-- http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_sec_6.2.4
-- http://www.haskell.org/onlinereport/numeric.html#sect14
--
-- # Add data types and parsers to support the full numeric tower of Scheme numeric types. Haskell has built-in types to represent many of these; check the Prelude. For the others, you can define compound types that represent eg. a Rational as a numerator and denominator, or a Complex as a real and imaginary part (each itself a Real number).
-- http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_sec_6.2.1
-- http://www.haskell.org/onlinereport/standard-prelude.html#$tNum
-- Recursive Parser: Adding lists, dotted lists, and quoted datums
parseList :: Parser LispVal
parseList = liftM List $ sepBy parseExpr spaces
parseDottedList :: Parser LispVal
parseDottedList = do
head <- endBy parseExpr spaces
tail <- char '.' >> spaces >> parseExpr
return $ DottedList head tail
parseQuoted :: Parser LispVal
parseQuoted = do
char '\''
x <- parseExpr
return $ List [Atom "quote", x]
parseExpr :: Parser LispVal
parseExpr = parseAtom
<|> parseString
<|> parseNumber
<|> parseQuoted
<|> do
char '('
x <- try parseList <|> parseDottedList
char ')'
return x
-- Evaluator
-- Print values
showVal :: LispVal -> String
showVal (String contents) = "\"" ++ contents ++ "\""
showVal (Atom name) = name
showVal (Number contents) = show contents
showVal (Bool True) = "#t"
showVal (Bool False) = "#f"
showVal (List contents) = "(" ++ unwordsList contents ++ ")"
showVal (DottedList head tail) = "(" ++ unwordsList head ++ " . " ++ showVal tail ++ ")"
unwordsList :: [LispVal] -> String
unwordsList = unwords . map showVal
instance Show LispVal where show = showVal
-- Primitives
eval :: LispVal -> ThrowsError LispVal
eval val@(String _) = return val
eval val@(Number _) = return val
eval val@(Bool _) = return val
eval (List [Atom "quote", val]) = return val
eval (List (Atom func : args)) = mapM eval args >>= apply func
eval badForm = throwError $ BadSpecialForm "Unrecognized special form" badForm
apply :: String -> [LispVal] -> ThrowsError LispVal
apply func args = maybe (throwError $ NotFunction "Unrecognized primitive function args" func)
($ args)
(lookup func primitives)
primitives :: [(String, [LispVal] -> ThrowsError LispVal)]
primitives = [("+", numericBinop (+)),
("-", numericBinop (-)),
("*", numericBinop (*)),
("/", numericBinop div),
("mod", numericBinop mod),
("quotient", numericBinop quot),
("remainder", numericBinop rem)]
numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
numericBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
numericBinop op params = mapM unpackNum params >>= return . Number . foldl1 op
unpackNum :: LispVal -> ThrowsError Integer
unpackNum (Number n) = return n
unpackNum (String n) = let parsed = reads n in
if null parsed
then throwError $ TypeMismatch "number" $ String n
else return $ fst $ parsed !! 0
unpackNum (List [n]) = unpackNum n
unpackNum notNum = throwError $ TypeMismatch "number" notNum
-- Error checking
data LispError = NumArgs Integer [LispVal]
| TypeMismatch String LispVal
| Parser ParseError
| BadSpecialForm String LispVal
| NotFunction String String
| UnboundVar String String
| Default String
showError :: LispError -> String
showError (UnboundVar message varname) = message ++ ": " ++ varname
showError (BadSpecialForm message form) = message ++ ": " ++ show form
showError (NotFunction message func) = message ++ ": " ++ show func
showError (NumArgs expected found) = "Expected " ++ show expected ++ " args; found values " ++ unwordsList found
showError (TypeMismatch expected found) = "Invalid type: expected " ++ expected ++ ", found " ++ show found
showError (Parser parseErr) = "Parse error at " ++ show parseErr
instance Show LispError where show = showError
instance Error LispError where
noMsg = Default "An error has occured"
strMsg = Default
type ThrowsError = Either LispError
trapError action = catchError action (return . show)
extractValue :: ThrowsError a -> a
extractValue (Right val) = val
-- Main
readExpr :: String -> ThrowsError LispVal
readExpr input = case parse parseExpr "lisp" input of
Left err -> throwError $ Parser err
Right val -> return val
main :: IO ()
main = do
args <- getArgs
evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
putStrLn $ extractValue $ trapError evaled
Loading…
Cancel
Save