diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..3f4cbed --- /dev/null +++ b/Makefile @@ -0,0 +1,2 @@ +all: + cabal install diff --git a/bc.cabal b/bc.cabal index eda6cde..6dcaa76 100644 --- a/bc.cabal +++ b/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 diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs new file mode 100644 index 0000000..4b54076 --- /dev/null +++ b/src/BC/Eval.hs @@ -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 "" diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs new file mode 100644 index 0000000..96641f0 --- /dev/null +++ b/src/BC/Parse.hs @@ -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 diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs index edb5f14..bc893bd 100644 --- a/src/BC/Prompt.hs +++ b/src/BC/Prompt.hs @@ -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 () diff --git a/src/BC/Types.hs b/src/BC/Types.hs new file mode 100644 index 0000000..412da85 --- /dev/null +++ b/src/BC/Types.hs @@ -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