diff --git a/README.md b/README.md index 124849a..07f340f 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,21 @@ # bc A better basic calculator. Like the original `bc`, but with a better -prompt. +prompt. Work in progress. Very incapable right now. + +## What? + +The idea behind `bc` is to display partial results to the right of the +cursor in yellow while we type. A little example can be found in the video +below. Other than that, we want to be compatible with the original `bc`, though +somewhat faster. We have infinite precision integers and double precision floats. + +## TODO + +Basically everything except calculating stuff with numbers. This includes: + +- A parser (foundations are laid) +- An evaluator (the current just does a tree rewrite on binary operations; this is + cute, but not capable enough for the full `bc` language, of course) +- A better data structure (numbers should probably have their own parent type to implement calculation) +- A good readline copy (haskeline is sadly out of the question for this project) diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs index 2d052c7..066dc8d 100644 --- a/src/BC/Eval.hs +++ b/src/BC/Eval.hs @@ -4,15 +4,17 @@ import BC.Types eval :: [Value] -> Value eval [x@(BInt _)] = x +eval [x@(BFloat _)] = x eval [x@(BErr _)] = x -eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments") +eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments") eval [] = BOp "" eval l = treeEval l [] [] treeEval :: [Value] -> [Value] -> [Value] -> Value treeEval [] [] (num:_) = num treeEval [] ops nums = handleOp [] ops nums -treeEval (x@(BInt _):xy) ops nums = treeEval xy ops (nums ++ [x]) +treeEval (x@(BInt _):xy) ops nums = treeEval xy ops (x:nums) +treeEval (x@(BFloat _):xy) ops nums = treeEval xy ops (x:nums) treeEval expr@(x@(BOp _):xy) ops@(op:_) nums = if precedence x > precedence op then treeEval xy (x:ops) nums @@ -20,7 +22,7 @@ treeEval expr@(x@(BOp _):xy) ops@(op:_) nums = treeEval (x@(BOp _):xy) [] nums = treeEval xy [x] nums handleOp :: [Value] -> [Value] -> [Value] -> Value -handleOp expr (op:ops) (op1:(op2:nums)) = +handleOp expr (op:ops) (op2:(op1:nums)) = treeEval expr ops ((evalOp op op1 op2):nums) handleOp expr ((BOp op):ops) _ = BErr ("Not enough arguments to operation " ++ op) @@ -30,4 +32,19 @@ evalOp (BOp "/") (BInt x) (BInt y) = BInt $ quot x y evalOp (BOp "+") (BInt x) (BInt y) = BInt $ x + y evalOp (BOp "-") (BInt x) (BInt y) = BInt $ x - y evalOp (BOp "^") (BInt x) (BInt y) = BInt $ x ^ y +evalOp (BOp "*") (BFloat x) (BInt y) = BFloat $ x * fromIntegral y +evalOp (BOp "/") (BFloat x) (BInt y) = BFloat $ x / fromIntegral y +evalOp (BOp "+") (BFloat x) (BInt y) = BFloat $ x + fromIntegral y +evalOp (BOp "-") (BFloat x) (BInt y) = BFloat $ x - fromIntegral y +evalOp (BOp "^") (BFloat x) (BInt y) = BFloat $ x ** fromIntegral y +evalOp (BOp "*") (BInt x) (BFloat y) = BFloat $ fromIntegral x * y +evalOp (BOp "/") (BInt x) (BFloat y) = BFloat $ fromIntegral x / y +evalOp (BOp "+") (BInt x) (BFloat y) = BFloat $ fromIntegral x + y +evalOp (BOp "-") (BInt x) (BFloat y) = BFloat $ fromIntegral x - y +evalOp (BOp "^") (BInt x) (BFloat y) = BFloat $ fromIntegral x ** y +evalOp (BOp "*") (BFloat x) (BFloat y) = BFloat $ x * y +evalOp (BOp "/") (BFloat x) (BFloat y) = BFloat $ x / y +evalOp (BOp "+") (BFloat x) (BFloat y) = BFloat $ x + y +evalOp (BOp "-") (BFloat x) (BFloat y) = BFloat $ x - y +evalOp (BOp "^") (BFloat x) (BFloat y) = BFloat $ x ** y evalOp _ _ _ = BInt 0 diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs index 96641f0..c4446cb 100644 --- a/src/BC/Parse.hs +++ b/src/BC/Parse.hs @@ -1,5 +1,7 @@ module BC.Parse (parse) where +import Data.Char + import qualified Text.ParserCombinators.Parsec as P import BC.Types @@ -7,9 +9,25 @@ import BC.Types symbol :: P.Parser Char symbol = P.oneOf "!%&|*+-/<=>^~" + number :: P.Parser Value -number = do - neg <- P.optionMaybe (P.string "-" P.<|> P.string "+") +number = P.try float P.<|> integer + + +float :: P.Parser Value +float = do + neg <- P.optionMaybe (P.string "-") + x <- P.many1 P.digit + _ <- P.string "." + y <- P.many1 P.digit + case neg of + Just "-" -> (return . BFloat . read) ("-" ++ x ++ "." ++ y) + _ -> (return . BFloat . read) (x ++ "." ++ y) + + +integer :: P.Parser Value +integer = do + neg <- P.optionMaybe (P.string "-") x <- P.many1 P.digit case neg of Just "-" -> (return . BInt . read) ("-" ++ x) @@ -24,6 +42,12 @@ 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 +parse input = case P.parse parser (trim input) (trim input) of Left err -> [BErr $ show err] Right val -> val + where trim s = trimR "" $ dropWhile isSpace s + trimR s "" = "" + trimR s (x:xs) + | isSpace x = trimR (x:s) xs + | null s = x:trimR "" xs + | otherwise = reverse s ++ x:trimR "" xs diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs index b2117ab..7b23e47 100644 --- a/src/BC/Prompt.hs +++ b/src/BC/Prompt.hs @@ -34,17 +34,31 @@ printStatus str = out = show evald in if isErr evald || length out == 0 then return () - else let str = " \x1b[33m=> " ++ out ++ "\x1b[0m" + else let str = " \x1b[33m=> " ++ trunc out ++ "\x1b[0m" in putStr (str ++ repeat '\b' (length str - 9)) where repeat str 0 = "" repeat str n = (str:repeat str (n-1)) + trunc s = if length s > 20 then take 20 s ++ "..." else s + + +cleanPrompt :: IO () +cleanPrompt = putStr "\x1b[2K\r" + + +-- TODO: Stub +readSpecialKey :: IO () +readSpecialKey = do + c <- getChar + c2 <- getChar + return () readline :: IO (Maybe String) -readline = do - putStr promptStr - read' "" +readline = read' "" where read' acc = do + cleanPrompt + putStr promptStr + putStr acc printStatus acc c <- getChar case c of @@ -57,6 +71,9 @@ readline = do read' (init acc) else do read' acc + '\x1b' -> do + readSpecialKey + read' acc c -> if isPrint c then do diff --git a/src/BC/Types.hs b/src/BC/Types.hs index b9bf2e0..fe583f7 100644 --- a/src/BC/Types.hs +++ b/src/BC/Types.hs @@ -1,10 +1,12 @@ module BC.Types where data Value = BInt Integer + | BFloat Double | BOp String | BErr String instance Show Value where show (BInt i) = show i + show (BFloat f) = show f show (BOp o) = o show (BErr e) = "error: " ++ e @@ -13,9 +15,10 @@ isErr (BErr _) = True isErr _ = False precedence :: Value -> Int -precedence (BOp "^") = 1 +precedence (BOp "^") = 3 precedence (BOp "*") = 2 precedence (BOp "/") = 2 precedence (BOp "-") = 1 precedence (BOp "+") = 1 +precedence (BOp "%") = 2 precedence _ = 0