initial public release

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)

src/BC/Eval.hs

@@ -4,6 +4,7 @@ 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 ""
@@ -12,7 +13,8 @@ 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

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

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

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