added parser and eval stub

This commit is contained in:
2017-04-28 18:07:46 +02:00
parent 71983ddf3e
commit 4c965e8891
6 changed files with 79 additions and 11 deletions

2
Makefile Normal file
View File

@@ -0,0 +1,2 @@
all:
cabal install

View File

@@ -14,6 +14,6 @@ cabal-version: >=1.10
executable bc
main-is: Main.hs
hs-source-dirs: src/
build-depends: base >=4.9 && <4.10, unix
build-depends: base >=4.9 && <4.10, parsec, unix
hs-source-dirs: src
default-language: Haskell2010

9
src/BC/Eval.hs Normal file
View File

@@ -0,0 +1,9 @@
module BC.Eval (eval) where
import BC.Types
eval :: [Value] -> Value
eval [x@(BInt _)] = x
eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments")
eval (x:xy) = x
eval [] = BOp ""

29
src/BC/Parse.hs Normal file
View File

@@ -0,0 +1,29 @@
module BC.Parse (parse) where
import qualified Text.ParserCombinators.Parsec as P
import BC.Types
symbol :: P.Parser Char
symbol = P.oneOf "!%&|*+-/<=>^~"
number :: P.Parser Value
number = do
neg <- P.optionMaybe (P.string "-" P.<|> P.string "+")
x <- P.many1 P.digit
case neg of
Just "-" -> (return . BInt . read) ("-" ++ x)
_ -> (return . BInt . read) x
operator :: P.Parser Value
operator = do
res <- P.many1 $ P.letter P.<|> symbol
return $ BOp res
parser :: P.Parser [Value]
parser = (P.sepBy (P.try operator P.<|> number) P.spaces) <* P.eof
parse :: String -> [Value]
parse input = case P.parse parser input input of
Left err -> [BErr $ show err]
Right val -> val

View File

@@ -5,6 +5,9 @@ import System.IO
import System.Posix.Signals
import BC.Config
import BC.Eval
import BC.Parse
import BC.Types
printHeader :: IO ()
printHeader = do
@@ -14,33 +17,45 @@ printHeader = do
output :: String -> IO ()
output out = putStrLn $ returnStr ++ out
output out =
let res = parse out
in if length res == 1 && isErr (res !! 0)
then putStrLn $ show (res !! 0)
else putStrLn $ returnStr ++ show (eval res)
readline :: IO (Maybe String)
readline = do
putStr promptStr
hFlush stdout
read' ""
where read' acc = do
c <- getChar
case c of
'\EOT' -> return Nothing
'\n' -> return (Just acc)
c -> read' (acc ++ [c])
'\DEL' ->
if length acc > 0
then do
putStr "\b \b"
read' (init acc)
else do
read' acc
c ->
if isPrint c
then do
putStr [c]
read' (acc ++ [c])
else read' acc
prompt :: IO ()
prompt = do
input <- readline
case input of
Nothing -> do
output "Bye!"
return ()
Just "quit" -> do
output "Bye!"
return ()
Nothing -> putStrLn "Bye!"
Just "quit" -> putStrLn "Bye!"
Just str -> do
putStrLn ""
output str
prompt
@@ -49,8 +64,8 @@ installHandlers :: IO ()
installHandlers = do
installHandler keyboardSignal (Catch (putStrLn "\n(interrupt) type quit to exit")) Nothing
hSetBuffering stdout NoBuffering
hSetEcho stdin False
hSetBuffering stdin NoBuffering
return ()
startPrompt :: IO ()

13
src/BC/Types.hs Normal file
View File

@@ -0,0 +1,13 @@
module BC.Types where
data Value = BInt Integer
| BOp String
| BErr String
instance Show Value where
show (BInt i) = show i
show (BOp o) = o
show (BErr e) = "error: " ++ e
isErr :: Value -> Bool
isErr (BErr _) = True
isErr _ = False