diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Expr.hs | 12 | ||||
| -rw-r--r-- | src/Main.hs | 60 | ||||
| -rw-r--r-- | src/parser/Expr.hs | 6 |
3 files changed, 42 insertions, 36 deletions
diff --git a/src/Expr.hs b/src/Expr.hs index 96c2fe6..852ee47 100644 --- a/src/Expr.hs +++ b/src/Expr.hs @@ -1,23 +1,25 @@ module Expr where +import Control.Monad import Data.List -import qualified Data.Map as M -import Control.Monad +import qualified Data.Map as M data Expr - = Rational Float + = Rational Float -- values | Imaginary Float | Complex Float Float | Matrix [[Expr]] - | Add Expr Expr + + | Add Expr Expr --- ops | Sub Expr Expr | Mul Expr Expr | Div Expr Expr | Mod Expr Expr | Exp Expr Expr | Dot Expr Expr - | Variable String + + | Variable String -- lables | Function String Expr deriving (Eq) diff --git a/src/Main.hs b/src/Main.hs index 1f99b39..f54cf7a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,55 +1,48 @@ import Data.Char -import qualified Data.Map as M -import System.IO +import qualified Data.Map as M +import System.Console.Haskeline -import Expr as E +import Expr as E import Parser.Core import Parser.Statement main :: IO () -main = promptLoop (Context M.empty M.empty) +main = runInputT defaultSettings $ promptLoop (Context M.empty M.empty) -promptLoop :: Context -> IO () +promptLoop :: Context -> InputT IO () promptLoop context = do - putStr "> " - hFlush stdout - eof <- isEOF - if eof - then return () - else do line <- getLine - if line /= "exit" - then loop line context >>= promptLoop - else return () + minput <- getInputLine "> " + case minput of + Nothing -> return () + Just "exit" -> return () + Just "env" -> putEnv context >>= promptLoop -loop :: String -> Context -> IO Context -loop input context = - do - case runParserStrict statementP (filter (not . isSpace) input) of - Left err -> putStrLn ("Error parsing: " ++ err) >> return context - Right s -> Main.eval s context + Just input -> do + case runParserStrict statementP (filter (not . isSpace) input) of + Left err -> outputStrLn ("Error parsing: " ++ err) >> promptLoop context + Right s -> Main.eval s context >>= promptLoop - -eval :: Statement -> Context -> IO Context +eval :: Statement -> Context -> InputT IO Context eval (Evaluation e) c = do case E.eval e c of - Just evaluated -> putStrLn $ show evaluated - Nothing -> putStrLn "Error: couldn't evaluate expression" + Just evaluated -> outputStrLn $ show evaluated + Nothing -> outputStrLn "Error: couldn't evaluate expression" return c eval (VariableDeclaration name value) (Context vars funcs) = case E.eval value context of - Just e -> do putStrLn $ show e + Just e -> do outputStrLn $ show e return $ Context (M.insert name e vars) funcs - Nothing -> putStrLn "Error: couldn't evaluate expression" >> return context + Nothing -> outputStrLn "Error: couldn't evaluate expression" >> return context where context = Context vars funcs eval (FunctionDeclaration name argName e) (Context vars funcs) = -- case evalIgnore e context argName of - -- Just e -> do putStrLn $ show e + -- Just e -> do outputStrLn $ show e -- return $ Context vars (M.insert name (argName, e) funcs) - -- Nothing -> putStrLn "Error: couldn't evaluate expression" >> return context + -- Nothing -> outputStrLn "Error: couldn't evaluate expression" >> return context -- -- where context = Context vars funcs return $ Context vars (M.insert name (argName, e) funcs) @@ -59,3 +52,14 @@ eval _ c = return c -- r <- eval right + +putEnv :: Context -> InputT IO Context +putEnv (Context vars funcs) = do + outputStrLn "Variables:" + outputStr $ M.foldrWithKey (foldFunc fmtVariable) "" vars + outputStrLn "Functions:" + outputStr $ M.foldrWithKey (foldFunc fmtFunction) "" funcs + return (Context vars funcs) + where foldFunc fmt k v acc = acc ++ fmt k v ++ "\n" + fmtVariable k v = k ++ " = " ++ show v + fmtFunction k (arg, v) = k ++ "(" ++ arg ++ ") = " ++ show v diff --git a/src/parser/Expr.hs b/src/parser/Expr.hs index 221d669..5334578 100644 --- a/src/parser/Expr.hs +++ b/src/parser/Expr.hs @@ -1,9 +1,9 @@ module Parser.Expr (exprP) where -import Control.Applicative +import Control.Applicative -import Parser.Core -import Expr +import Expr +import Parser.Core -- Parse expression separated by one infix operator of the operator list |