summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-12 21:57:05 +0000
committerDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-12 21:57:05 +0000
commit05ef8ac17d96968c4e86196336881ba710fbc838 (patch)
treef285b40b3c667faa34feaa8454a3692203d93305
parentc2e16e868e78df03b7a35ee3bbaefcb2ba4816c1 (diff)
downloadcalculator-05ef8ac17d96968c4e86196336881ba710fbc838.tar.bz2
Fix a bug and allow runtime errors without dying
-rw-r--r--calculator.hs15
1 files changed, 10 insertions, 5 deletions
diff --git a/calculator.hs b/calculator.hs
index a59f0fb..767845d 100644
--- a/calculator.hs
+++ b/calculator.hs
@@ -4,6 +4,7 @@ import Text.Parsec.Token
import Text.Parsec.Language
import Text.Parsec.Expr
import Control.Monad.State
+import Control.Monad.Error
import qualified Data.Map as M
data Expression = Constant Double
@@ -94,7 +95,8 @@ parseInput = do
type StoredVal = Either Double FunctionBody
-type Calculator a = StateT (M.Map String StoredVal) IO a
+type CannotFailCalculator = StateT (M.Map String StoredVal) IO
+type Calculator a = ErrorT String CannotFailCalculator a
interpretExpression :: Expression -> Calculator Double
interpretExpression (Constant n) = return n
@@ -140,7 +142,7 @@ interpretExpression (FunctionInvocation fn e) = do
n <- interpretExpression e
modify (M.insert argname (Left n))
r <- interpretExpression expr
- modify (M.delete argname)
+ put ctx
return r
interpretStatement :: Statement -> Calculator ()
@@ -160,15 +162,18 @@ defaultVars = M.fromList
, ("phi", Left ((1 + (sqrt 5)) / 2))
]
-calculate :: String -> Calculator ()
+calculate :: String -> CannotFailCalculator ()
calculate s =
case ret of
Left e -> liftIO $ putStrLn $ "error: " ++ (show e)
- Right n -> interpretStatement n
+ Right n -> do res <- runErrorT $ interpretStatement n
+ case res of
+ Left e' -> liftIO $ putStrLn $ "run error: " ++ e'
+ Right _ -> return ()
where
ret = parse parseInput "" s
-calculator :: Calculator ()
+calculator :: CannotFailCalculator ()
calculator =
liftIO getContents >>= (mapM_ calculate) . lines