From bd759f8dd5d70e266c0eae97d7076976cf2fc2a3 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@praseodym.org>
Date: Thu, 5 Mar 2015 20:01:08 +0000
Subject: Variables & Symbol 'e'

---
 rpn.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 49 insertions(+), 4 deletions(-)

diff --git a/rpn.hs b/rpn.hs
index a0d33ef..5c75fcf 100644
--- a/rpn.hs
+++ b/rpn.hs
@@ -1,8 +1,13 @@
 import Control.Monad (join, sequence)
 import System.Environment (getArgs)
+import Data.Maybe (listToMaybe, isJust)
+import Data.Char (isSpace)
+import Data.List (nub)
 import qualified Control.Monad.State as S
+import qualified Data.Map as M
+import System.IO
 
-data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc deriving (Eq, Ord, Show)
+data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc | Exp deriving (Eq, Ord, Show)
 instance Floating a => Num (Symbol a) where
   (Number x del) + (Number y del') = Number (x + y) (abs $ gMean [del, del'])
   _ + _ = Err
@@ -32,14 +37,47 @@ fromSymbol :: Floating a => Symbol a -> (a, a)
 fromSymbol (Number x d) = (x, d)
 fromSymbol _ = (0, 0)
 
+
+pPrint :: Show a => Symbol a -> String
+pPrint (Number x d) = (show x) ++ " ± " ++ (show d)
+pPrint s = show s
+
 main :: IO ()
 main = do
-  (mode:stdin:_) <- getArgs
-  let symbols = map interpreteSymbol $ join $ map words . lines $ stdin
-      result = evalExpVec symbols
+  hSetBuffering stdin LineBuffering
+  hSetBuffering stdout NoBuffering
+  (mode:args) <- getArgs
+  let symbols = join . join $ map (map words) . map lines $ args
+      unknownSymbols = nub $ filter (not . isKnownSymbol) symbols
+  symbolMap <- sequence $ map (sequencePair . (\x -> (x, clarifySymbol x))) unknownSymbols
+  let symbolMap' = M.fromList symbolMap
+      symbols' = map (\x -> if x `elem` (M.keys symbolMap') then symbolMap' M.! x else [x]) symbols
+      symbols'' = map interpreteSymbol $ join symbols'
+  let result = evalExpVec symbols''
   case mode of
     "n" -> putStrLn . show . fst $ fromSymbol result
     "e" -> putStrLn . show . snd $ fromSymbol result
+    _ -> putStrLn $ pPrint result
+
+clarifySymbol :: String -> IO [String]
+clarifySymbol s = do
+  putStr $ "Define " ++ s ++ ": "
+  line <- getLine
+  return $ words line
+
+isKnownSymbol :: String -> Bool
+isKnownSymbol s = or [
+  s `elem` ["+", "-", "*", "/", "±", "e"],
+  isJust $ (maybeRead s :: Maybe Double)
+                     ]
+
+sequencePair :: (a, IO b) -> IO (a, b)
+sequencePair (a, b) = do
+  b' <- b
+  return (a, b')
+
+maybeRead :: (Read a) => String -> Maybe a
+maybeRead = fmap fst . listToMaybe . filter (null . dropWhile isSpace . snd) . reads
 
 interpreteSymbol :: String -> Symbol Double
 interpreteSymbol "+" = Add
@@ -47,6 +85,7 @@ interpreteSymbol "-" = Sub
 interpreteSymbol "*" = Mult
 interpreteSymbol "/" = Div
 interpreteSymbol "±" = Unc
+interpreteSymbol "e" = Exp
 interpreteSymbol x = Number (read x) 0
 
 evalExpVec :: Floating a => [Symbol a] -> Symbol a
@@ -76,3 +115,9 @@ evalExp Mult = do
 evalExp Div = do
   state <- S.get
   S.put $ ((foldl1 (/) . reverse $ take 2 state):drop 2 state)
+evalExp Exp = do
+  state <- S.get
+  let
+    b = state !! 1
+    e = state !! 0
+  S.put $ ((b * (Number (10 ** (fst $ fromSymbol e)) 0)):drop 2 state)
-- 
cgit v1.2.3