diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ *.hi *.o husky +PropertyTest *.swp TAGS diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,20 @@ +2008-02-22 Markus Dittrich + + * 0.2 release + + * added builtin trigonometric and hyperbolic + functions. + + * reworked real exponential function in terms of + glibc's pow() function. + + * added ability to list all defined variables via + \v + + * improved unit test framework. + + + +2008-02-18 Markus Dittrich + + * 0.1 release diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ # Copyright 2008 Markus Dittrich # Distributed under the terms of the GNU General Public License v3 -VERSION=0.1 +VERSION=0.2 DESTDIR= mandir=$(DESTDIR)/usr/share/man/man1 docdir=$(DESTDIR)/usr/share/doc/husky-$(VERSION) @@ -12,15 +12,15 @@ GHC_FLAGS_RELEASE = -O2 OBJECTS = src/husky.hs src/CalculatorParser.hs src/CalculatorState.hs \ - src/PrettyPrint.hs src/TokenParser.hs + src/ExtraFunctions.hs src/PrettyPrint.hs src/TokenParser.hs all: husky -husky: $(OBJECTS) +husky: $(OBJECTS) ghc -i./src $(GHC_FLAGS_RELEASE) --make src/husky.hs -debug: $(OBJECTS) +debug: $(OBJECTS) ghc -i./src $(GHC_FLAGS_DEVEL) --make src/husky.hs @@ -33,7 +33,7 @@ install -d $(bindir) install -d $(htmldir) install -m 0755 src/husky $(bindir)/ - install -m 0644 COPYING AUTHORS $(docdir)/ + install -m 0644 ChangeLog COPYING AUTHORS $(docdir)/ install -m 0644 doc/usage.html $(htmldir)/ diff --git a/doc/usage.html b/doc/usage.html --- a/doc/usage.html +++ b/doc/usage.html @@ -294,7 +294,7 @@ Author: Markus Dittrich Version: -0.1 (02/18/2008) +0.2 (02/22/2008)
@@ -308,10 +308,12 @@ precision. In addition to the standard operations above, the following functions are currently supported:

    -
  • sqrt : square root
    • -
  • a^n : exponentiation (n can be arbitrary double)
    • -
  • exp : exponential function
    • -
  • cos, sin, tan : trigonometric functions
    • +
  • sqrt : square root
    • +
  • a^n : exponentiation (n can be arbitrary double)
    • +
  • exp : exponential function
    • +
  • ln, log2, log10 : natural, base2, and base10 logarithm
    • +
  • cos, sin, tan, acos, asin, atan: trigonometric functions and inverse
    • +
  • cosh, sinh, tanh, acosh, asinh, atanh: hyperbolic trigonometric functions and inverse

Furthermore, users can define any number of variables via

variable name = value

@@ -323,9 +325,15 @@ related functionality is available at husky's interactive prompt (including command history). See [1] for more detail.

-

You can exit a husky session anytime by typing :q at -the command prompt.

+
+

Command Shortcuts

+

The following commands are available at the command prompt:

+
    +
  • \q : quit husky
    • +
  • \v : list all currently defined variables
    • +
+

BUGS

-

Please report all bugs to <markusle@gmail.com>. Thank you!

+

Please report all bugs to <haskelladdict@gmail.com>. Thank you!

References

diff --git a/doc/usage.rst b/doc/usage.rst --- a/doc/usage.rst +++ b/doc/usage.rst @@ -4,7 +4,7 @@ :Author: Markus Dittrich -:Version: 0.1 (02/18/2008) +:Version: 0.2 (02/22/2008) Introduction @@ -20,11 +20,14 @@ precision. In addition to the standard operations above, the following functions are currently supported: -- sqrt : square root -- a^n : exponentiation (n can be arbitrary double) -- exp : exponential function -- cos, sin, tan : trigonometric functions +- *sqrt* : square root +- *a^n* : exponentiation (n can be arbitrary double) +- *exp* : exponential function +- *ln, log2, log10* : natural, base2, and base10 logarithm +- *cos, sin, tan, acos, asin, atan*: trigonometric functions and inverse +- *cosh, sinh, tanh, acosh, asinh, atanh*: hyperbolic trigonometric functions and inverse + Furthermore, users can define any number of variables via *variable name* = value @@ -39,10 +42,16 @@ prompt (including command history). See [1]_ for more detail. -You can exit a husky session anytime by typing :q at -the command prompt. +Command Shortcuts +----------------- +The following commands are available at the command prompt: + +- \\q : quit husky +- \\v : list all currently defined variables + + COPYRIGHT and LICENSE --------------------- @@ -61,7 +70,7 @@ BUGS ---- -Please report all bugs to . Thank you! +Please report all bugs to . Thank you! References diff --git a/husky.cabal b/husky.cabal --- a/husky.cabal +++ b/husky.cabal @@ -1,5 +1,5 @@ Name: husky -Version: 0.1 +Version: 0.2 License: GPL license-file: COPYING copyright: (c) 2008 Markus Dittrich @@ -8,8 +8,8 @@ Description: husky is a command line calculator with a small memory footprint. It can be used in a fashion similar to the interactive shells of python, octave, or ruby. -Author: Markus Dittrich -Maintainer: Markus Dittrich +Author: Markus Dittrich +Maintainer: Markus Dittrich stability: alpha build-type: Simple Homepage: http://github.com/markusle/husky/tree/master diff --git a/src/CalculatorParser.hs b/src/CalculatorParser.hs --- a/src/CalculatorParser.hs +++ b/src/CalculatorParser.hs @@ -28,6 +28,7 @@ -- local imports import CalculatorState +import ExtraFunctions import TokenParser diff --git a/src/ExtraFunctions.hs b/src/ExtraFunctions.hs new file mode 100644 --- /dev/null +++ b/src/ExtraFunctions.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{----------------------------------------------------------------- + + (c) 2008-2009 Markus Dittrich + + This program is free software; you can redistribute it + and/or modify it under the terms of the GNU General Public + License Version 3 as published by the Free Software Foundation. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License Version 3 for more details. + + You should have received a copy of the GNU General Public + License along with this program; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. + +--------------------------------------------------------------------} + +-- | definition of a few additional function (from libc) +module ExtraFunctions ( real_exp + , dbl_epsilon + ) where + + +-- imports +import Foreign() +import Foreign.C.Types + + +-- | use glibc DBL_EPSILON +dbl_epsilon :: Double +dbl_epsilon = 2.2204460492503131e-16 + + +-- | helper function for defining real powers +-- NOTE: We use glibc's pow function since it is more +-- precise than implementing it ourselves via, e.g., +-- pow a x = exp $ x * log a +foreign import ccall "math.h pow" + c_pow :: CDouble -> CDouble -> CDouble + +real_exp :: Double -> Double -> Double +real_exp a x = realToFrac $ c_pow (realToFrac a) (realToFrac x) diff --git a/src/Messages.hs b/src/Messages.hs --- a/src/Messages.hs +++ b/src/Messages.hs @@ -31,6 +31,11 @@ import PrettyPrint +-- current version +version :: String +version = "0.2" + + -- | display output somewhat colorful husky_result :: IO () husky_result = do @@ -40,7 +45,8 @@ -- | greeting show_greeting :: IO () show_greeting = do - putStrLn "Welcome to husky (v0.1) (C) 2009 Markus Dittrich" + putStrLn $ "Welcome to husky (v" ++ version + ++ ") (C) 2009 Markus Dittrich" putStrLn "-------------------------------------------------" diff --git a/src/TokenParser.hs b/src/TokenParser.hs --- a/src/TokenParser.hs +++ b/src/TokenParser.hs @@ -29,7 +29,6 @@ , keywords , OperatorAction , operators - , real_exp , reservedOp , reserved , stringLiteral @@ -64,10 +63,22 @@ keywords :: [(String, OperatorAction)] keywords = [ ("sqrt",sqrt) - , ("exp",exp) - , ("sin",sin) - , ("cos",cos) - , ("tan",tan)] + , ("exp",exp) + , ("log",log) + , ("log2", logBase 2) + , ("log10", logBase 10) + , ("sin",sin) + , ("cos",cos) + , ("tan",tan) + , ("asin", asin) + , ("acos", acos) + , ("atan", atan) + , ("sinh", sinh) + , ("cosh", cosh) + , ("tanh", tanh) + , ("asinh", sinh) + , ("acosh", cosh) + , ("atanh", atanh)] operators :: [String] @@ -122,8 +133,3 @@ -- | token parser for keywords reserved :: String -> CharParser st () reserved = PT.reserved lexer - - --- | helper function for defining real powers -real_exp :: Double -> Double -> Double -real_exp a x = exp $ x * log a diff --git a/src/husky.hs b/src/husky.hs --- a/src/husky.hs +++ b/src/husky.hs @@ -23,6 +23,7 @@ -- imports +import Data.Map import System.Console.Readline -- local imports @@ -48,7 +49,8 @@ input <- readline $ color_string Red "husky> " case input of Nothing -> parse_it state - Just ":q" -> return () + Just "\\q" -> return () -- quit + Just "\\v" -> list_variables state -- list all defined variables Just line -> do addHistory line @@ -63,3 +65,13 @@ >> parse_it newState + + +-- | list all currently defined variables +list_variables :: CalcState -> IO () +list_variables state@(CalcState { varMap = theMap }) = + mapM_ print_variable (assocs theMap) + >> parse_it state + + where + print_variable x = putStrLn (fst x ++ " == " ++ (show $ snd x)) diff --git a/test/PropertyTest.hs b/test/PropertyTest.hs --- a/test/PropertyTest.hs +++ b/test/PropertyTest.hs @@ -30,6 +30,7 @@ -- local imports import CalculatorParser import CalculatorState +import ExtraFunctions import PrettyPrint import TokenParser @@ -39,16 +40,19 @@ -- and then examine the results afterward main :: IO () main = do + putStr $ color_string Cyan "\nSimple tests:\n" let simple = execWriter $ test_driver defaultCalcState simpleTests status1 <- examine_output simple + putStr $ color_string Cyan "\nFailure tests:\n" let failing = execWriter $ test_driver defaultCalcState failingTests status2 <- examine_output failing + putStr $ color_string Cyan "\nVariable tests:\n" let vars = execWriter $ test_driver defaultCalcState variableTests status3 <- examine_output vars - let status = status1 && status2 && status3 + let status = status1 && status2 && status3 if status == True then exitWith ExitSuccess else @@ -109,7 +113,7 @@ examine_result :: Maybe Double -> Maybe Double -> String -> Writer [TestResult] () examine_result target actual token = - if target == actual + if (is_equal target actual) then do tell [TestResult True token target actual] test_driver newState xs @@ -117,6 +121,14 @@ tell [TestResult False token target actual] test_driver newState xs + where + -- we compare doubles x,y for equality by means + -- of abs(x-y) <= dbl_epsilon * abs(x) + is_equal Nothing Nothing = True + is_equal (Just a) (Just b) = + abs(a-b) <= abs(a) * dbl_epsilon + is_equal _ _ = False + -- | our test results consist of a bool indicating success -- or failure, the test token as well as the expected and @@ -242,8 +254,8 @@ variableTests :: [TestCase] variableTests = [ variableTest1, variableTest2, variableTest3 , variableTest4, variableTest5, variableTest6 - , variableTest7, variableTest8, variableTest9 ] -{- , variableTest10, variableTest11, variableTest12 ] -} + , variableTest7, variableTest8, variableTest9 + , variableTest10, variableTest11, variableTest12 ] -- list of failing tests variableTest1 :: TestCase @@ -274,12 +286,11 @@ variableTest9 = ("(a*b) - kjhdskfsd123hjksdf", Just 0) variableTest10 :: TestCase -variableTest10 = ("c = 2", Nothing) +variableTest10 = ("c = 2", Just 2) variableTest11 :: TestCase variableTest11 = ("a-b-c + ( a + b + c ) + (a*a)", Just 168) variableTest12 :: TestCase variableTest12 = ("b^a - c", Just 16777214) -