diff --git a/src/Math/Haskellator/Internal/AstProcessingSteps/Evaluate.hs b/src/Math/Haskellator/Internal/AstProcessingSteps/Evaluate.hs index 9820c71..c904089 100644 --- a/src/Math/Haskellator/Internal/AstProcessingSteps/Evaluate.hs +++ b/src/Math/Haskellator/Internal/AstProcessingSteps/Evaluate.hs @@ -28,7 +28,7 @@ execute :: Expr -- ^ the expression tree to evaluate -> Either Error (Value Dimension) -- ^ the result or an error execute expr = do r <- runAstFold $ execute' expr - return $ r { unit = filterUnwanted $ unit r } + return $ r { unit = filterZeroPower $ unit r } execute' :: Expr -> SimpleAstFold (Value Dimension) execute' = partiallyFoldExprM execVal execBinOp execUnaryOp execConversion execVarBinds execVar @@ -48,10 +48,10 @@ execBinOp lhs Div rhs = do let u = subtractUnits (unit lhs) (unit rhs) return $ Value (value lhs / value rhs) u execBinOp lhs Pow rhs = case rhs of - Value _ [UnitExp Multiplier _] -> return $ Value (value lhs ** value rhs) ((\u -> u { + Value _ [] -> return $ Value (value lhs ** value rhs) ((\u -> u { power = power u * (round (value rhs) :: Int) }) <$> unit lhs) - _ -> throwError $ Error RuntimeError "Exponentiation of units is not supported" + _ -> throwError $ Error RuntimeError "Exponentiation of units is not supported" execBinOp _ op _ = throwError $ Error ImplementationError $ "Unknown binary operator " ++ show op execUnaryOp :: Op -> Value Dimension -> SimpleAstFold (Value Dimension) @@ -105,11 +105,5 @@ findPair x (y:ys) | dimUnit x == dimUnit y = ([(x, y)], ([], ys)) | otherwise = let (pair, (lr, rr)) = findPair x ys in (pair, (lr, y:rr)) -filterUnwanted :: Dimension -> Dimension -filterUnwanted = filterZeroPower . filterMultiplier - filterZeroPower :: Dimension -> Dimension filterZeroPower = filter ((/=0) . power) - -filterMultiplier :: Dimension -> Dimension -filterMultiplier = filter (not . isMultiplier . dimUnit) diff --git a/src/Math/Haskellator/Internal/AstProcessingSteps/Normalize.hs b/src/Math/Haskellator/Internal/AstProcessingSteps/Normalize.hs index 913e6bc..447401a 100644 --- a/src/Math/Haskellator/Internal/AstProcessingSteps/Normalize.hs +++ b/src/Math/Haskellator/Internal/AstProcessingSteps/Normalize.hs @@ -17,7 +17,7 @@ import Math.Haskellator.Internal.Utils.Error -- | Normalize all values inside the tree to their base units normalize :: Expr -- ^ the 'Expr' tree to normalize -> Either Error Expr -- ^ the normalized 'Expr' tree -normalize = Right . foldExpr (Val . convertDimensionToBase) BinOp UnaryOp Conversion VarBindings Var +normalize = Right . foldExpr (Val . filterMultiplier . convertDimensionToBase) BinOp UnaryOp Conversion VarBindings Var -- | Converts a value to its base dimension -- >>> convertDimensionToBase $ Value 1 [UnitExp Kilometer 2, UnitExp Hour 1] @@ -59,3 +59,6 @@ convertUnit s (t:ts) val@(Value v u) = case convertTo (Value 1 s) t of Nothing -> do (v', rest) <- convertUnit s ts val return (v', t:rest) + +filterMultiplier :: AstValue -> AstValue +filterMultiplier (Value v u) = Value v $ filter (not . isMultiplier . dimUnit) u diff --git a/src/Math/Haskellator/Internal/Parser.hs b/src/Math/Haskellator/Internal/Parser.hs index 046ffeb..a252625 100644 --- a/src/Math/Haskellator/Internal/Parser.hs +++ b/src/Math/Haskellator/Internal/Parser.hs @@ -35,6 +35,7 @@ import Control.Monad.State import Data.Bifunctor import Math.Haskellator.Internal.AstProcessingSteps.Evaluate +import Math.Haskellator.Internal.AstProcessingSteps.Normalize import Math.Haskellator.Internal.DerivedUnits import Math.Haskellator.Internal.Expr import Math.Haskellator.Internal.Lexer @@ -164,7 +165,7 @@ parseUnitExp = do either (\x -> fail $ "Invalid unit " ++ x) (\dim -> do { requireOperator "^"; expr <- parsePrimary; - case execute expr of + case normalize expr >>= execute of Right (Value v []) -> let e = round v :: Int in return ((\(UnitExp u e') -> UnitExp u $ e' * e) <$> dim) _ -> fail "Exponentiation of units is not supported" } <|> return dim) $ parseUnitSymbol i diff --git a/test/Evaluation.hs b/test/Evaluation.hs index 30c24b8..2c31f17 100644 --- a/test/Evaluation.hs +++ b/test/Evaluation.hs @@ -40,8 +40,8 @@ normalization = testGroup "Normalization" [ @?= Right (BinOp (Val $ Value 1 $ meter 42) Div (Val $ Value 1 $ second 33)) ] -evalString :: String -> Either Error Double -evalString = scan >=> parse >=> evaluate - normalizeString :: String -> Either Error Expr normalizeString = scan >=> parse >=> normalize + +evalString :: String -> Either Error Double +evalString = normalizeString >=> evaluate diff --git a/test/Parser.hs b/test/Parser.hs index ae56998..70ab52c 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -65,7 +65,7 @@ genInt = do instance Arbitrary Unit where -- Multiplier needs to be excluded here to prevent ambiguous cases in our grammar -- e.g. 2^2 could be either a multiplier with exponent two or a power operation on two multipliers with exponent 1 - arbitrary = arbitraryBoundedEnum `suchThat` (/= Multiplier) + arbitrary = arbitraryBoundedEnum `suchThat` (not . isMultiplier) instance Arbitrary Expr where arbitrary = let randomValue = do {