added parser and eval stub
This commit is contained in:
2
bc.cabal
2
bc.cabal
@@ -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
9
src/BC/Eval.hs
Normal 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
29
src/BC/Parse.hs
Normal 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
|
@@ -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
13
src/BC/Types.hs
Normal 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
|
Reference in New Issue
Block a user