From d3f63b1d1547fde2f73459ca1c237d361b233326 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Mon, 16 Sep 2024 17:30:25 +0200 Subject: [PATCH 1/2] Support for nested variable definitions --- app/Main.hs | 27 +++++++++++++++++---------- src/Lib.hs | 33 +++++++++++++++++++++++---------- 2 files changed, 40 insertions(+), 20 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 669c576..6252a07 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,7 @@ module Main (main) where import Text.Parsec -import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions) +import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables) import Data.Map (Map) import qualified Data.Map as Map @@ -21,20 +21,27 @@ precision = 5 :: Int showRatio :: Int -> Rational -> String showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "") where - prepoint_digits = init . show . round . abs $ (r * 10) - postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) + prepoint_digits = init . show . round . abs $ (r * 10) + postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) -useResult :: Map String Rational -> Either ParseError Expr -> String -useResult vs (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vs -useResult vs (Left error) = show error +useResult :: Map String Rational -> Expr -> String +useResult vs expr = either id ((showRatio precision) . evaluate) $ replaceVars expr vs ioLoop :: Map String Rational -> IO () ioLoop vs = do done <- isEOF if done then putStrLn "Quit!" else do inp <- getLine - let expr = parse exprparser "" inp - let uvs = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr - putStrLn $ useResult uvs expr - ioLoop uvs + let expr_res = parse exprparser "" inp + case expr_res of + Left err -> do + putStrLn . show $ err + ioLoop vs + Right expr -> do + let vardefs = extractVariableDefinitions expr + let uvs_res = updateVariables vardefs vs + case uvs_res of + Left err -> putStrLn err + Right uvs -> putStrLn $ useResult uvs expr + ioLoop (either (const vs) (id) uvs_res) diff --git a/src/Lib.hs b/src/Lib.hs index ceee931..837103c 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions + ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables ) where import Control.Applicative((<*)) @@ -14,7 +14,7 @@ import Text.Parsec.Expr import Text.Parsec.Token import Text.Parsec.Language -data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Rational +data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Expr deriving Show data BinaryOperator = Plus | Minus | Multiply | Divide | Power deriving Show @@ -80,7 +80,7 @@ variableDefinition :: Parser Expr variableDefinition = try (do name <- m_identifier _ <- char '=' - value <- constantInteger <|> constantRational + value <- exprparser return (VariableDefinition name value) ) @@ -90,16 +90,29 @@ term = m_parens exprparser <|> fmap Constant constantInteger <|> fmap Constant constantRational -extractVariableDefinitions :: Expr -> Map.Map String Rational -extractVariableDefinitions (VariableDefinition name value) = Map.singleton name value -extractVariableDefinitions (Binary _ a b) = Map.union (extractVariableDefinitions a) (extractVariableDefinitions b) -extractVariableDefinitions (Constant _) = Map.empty -extractVariableDefinitions (Variable _) = Map.empty +extractVariableDefinitions :: Expr -> [(String,Expr)] +extractVariableDefinitions (VariableDefinition name value) = [(name, value)] +extractVariableDefinitions (Binary _ a b) = extractVariableDefinitions a ++ extractVariableDefinitions b +extractVariableDefinitions (Constant _) = [] +extractVariableDefinitions (Variable _) = [] + +updateVariables :: [(String, Expr)] -> Map String Rational -> Either String (Map String Rational) +updateVariables ds vs = foldl updateVariable (Right vs) ds + +updateVariable :: Either String (Map String Rational) -> (String, Expr) -> Either String (Map String Rational) +updateVariable (Left e) _ = Left e +updateVariable (Right vs) (name, e) = case updateVariables nvs vs of + Left e -> Left e + Right uvs -> case replaceVars e uvs of + Left e -> Left e + Right exp -> Right $ Map.insert name (evaluate exp) uvs + where + nvs = extractVariableDefinitions e replaceVars :: Expr -> Map.Map String Rational -> Either String Expr replaceVars (Constant c) vs = Right $ Constant c replaceVars (Variable name) vs = maybe (Left ("Usage of unknown variable: '" ++ name ++ "'\nSuggestion: define the variable\n++ " ++ name ++ "=42")) (Right . Constant . id) $ Map.lookup name vs -replaceVars (VariableDefinition _ value ) vs = Right $ Constant value +replaceVars (VariableDefinition name _) vs = replaceVars (Variable name) vs replaceVars (Binary op l r) vs = case leftBranch of Left s -> Left s Right a -> case rightBranch of @@ -107,7 +120,7 @@ replaceVars (Binary op l r) vs = case leftBranch of Right b -> Right $ Binary op a b where leftBranch = replaceVars l vs - rightBranch = replaceVars r vs + rightBranch = replaceVars r vs {- - a/b ^ c/d From 5bc54cd13ad9d9971890f0b01378afa8f9c1e223 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Mon, 16 Sep 2024 18:40:21 +0200 Subject: [PATCH 2/2] Improved variable definition error messages --- src/Lib.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 837103c..8e9a7e5 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -102,9 +102,9 @@ updateVariables ds vs = foldl updateVariable (Right vs) ds updateVariable :: Either String (Map String Rational) -> (String, Expr) -> Either String (Map String Rational) updateVariable (Left e) _ = Left e updateVariable (Right vs) (name, e) = case updateVariables nvs vs of - Left e -> Left e + Left e -> Left $ "In definition of variable '" ++ name ++ "':\n" ++ e Right uvs -> case replaceVars e uvs of - Left e -> Left e + Left e -> Left $ "In definition of variable '" ++ name ++ "':\n" ++ e Right exp -> Right $ Map.insert name (evaluate exp) uvs where nvs = extractVariableDefinitions e @@ -130,7 +130,9 @@ replaceVars (Binary op l r) vs = case leftBranch of rationalPower :: Rational -> Rational -> Rational rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, denominator b) where - rationalPower' (a, b) (c, 1) = a ^ c % b ^ c + rationalPower' (a, b) (c, 1) + | c >= 0 = a ^ c % b ^ c + | otherwise = 1 / rationalPower (a % b) (-c % 1) rationalPower' _ _ = error "Powers with unnatural numbers are not supported yet" evaluate :: Expr -> Rational