Compare commits
3 commits
107f887147
...
e38576c1d8
Author | SHA1 | Date | |
---|---|---|---|
e38576c1d8 | |||
b4bbd298a0 | |||
ff5197de5c |
4 changed files with 36 additions and 9 deletions
19
app/Main.hs
19
app/Main.hs
|
@ -2,16 +2,31 @@ module Main (main) where
|
||||||
|
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
|
|
||||||
import Lib (exprparser, evaluate)
|
import Lib (exprparser, evaluate, replaceVars)
|
||||||
|
|
||||||
|
import Data.Map (Map)
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import Data.Ratio
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = ioLoop
|
main = ioLoop
|
||||||
|
|
||||||
useResult (Right e) = show . evaluate $ e
|
precision = 5 :: Int
|
||||||
|
|
||||||
|
showRatio :: Int -> Rational -> String
|
||||||
|
showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ "." ++ postpoint_digits
|
||||||
|
where
|
||||||
|
prepoint_digits = init . show . round $ (r * 10)
|
||||||
|
postpoint_digits = (take p) . (drop (length prepoint_digits)) . show . round $ (r * 10^p)
|
||||||
|
|
||||||
|
useResult (Right e) = (showRatio precision) . evaluate $ replaceVars e vars
|
||||||
useResult (Left e) = show e
|
useResult (Left e) = show e
|
||||||
|
|
||||||
|
vars :: Map String Rational
|
||||||
|
vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)]
|
||||||
|
|
||||||
ioLoop :: IO ()
|
ioLoop :: IO ()
|
||||||
ioLoop = do done <- isEOF
|
ioLoop = do done <- isEOF
|
||||||
if done
|
if done
|
||||||
|
|
3
hc.cabal
3
hc.cabal
|
@ -35,6 +35,7 @@ library
|
||||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
|
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
|
, containers
|
||||||
, parsec
|
, parsec
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
@ -49,6 +50,7 @@ executable hc-exe
|
||||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
|
, containers
|
||||||
, hc
|
, hc
|
||||||
, parsec
|
, parsec
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -65,6 +67,7 @@ test-suite hc-test
|
||||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
|
, containers
|
||||||
, hc
|
, hc
|
||||||
, parsec
|
, parsec
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -22,6 +22,7 @@ description: Please see the README on GitHub at <https://github.com/gith
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- parsec
|
- parsec
|
||||||
|
- containers
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
|
|
18
src/Lib.hs
18
src/Lib.hs
|
@ -1,9 +1,11 @@
|
||||||
module Lib
|
module Lib
|
||||||
( exprparser, evaluate
|
( exprparser, evaluate, replaceVars
|
||||||
) where
|
) where
|
||||||
import Control.Applicative((<*))
|
import Control.Applicative((<*))
|
||||||
|
|
||||||
import Data.Ratio
|
import Data.Ratio
|
||||||
|
import Data.Map (Map)
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
import Text.Parsec.Char
|
import Text.Parsec.Char
|
||||||
|
@ -26,7 +28,7 @@ def = emptyDef{ commentStart = ""
|
||||||
, opStart = oneOf "+-/*^"
|
, opStart = oneOf "+-/*^"
|
||||||
, opLetter = oneOf "+-/*^"
|
, opLetter = oneOf "+-/*^"
|
||||||
, reservedOpNames = ["+", "-", "/", "*", "^"]
|
, reservedOpNames = ["+", "-", "/", "*", "^"]
|
||||||
, reservedNames = ["pi", "e"]
|
, reservedNames = []
|
||||||
}
|
}
|
||||||
|
|
||||||
TokenParser{ parens = m_parens
|
TokenParser{ parens = m_parens
|
||||||
|
@ -66,11 +68,12 @@ constantRational :: Parser Rational
|
||||||
constantRational = do
|
constantRational = do
|
||||||
natural <- m_natural
|
natural <- m_natural
|
||||||
_ <- char '.'
|
_ <- char '.'
|
||||||
decimal <- m_natural
|
decimal_digits <- many digit
|
||||||
|
let decimal = read decimal_digits :: Integer
|
||||||
let natural_length = length . show $ natural
|
let natural_length = length . show $ natural
|
||||||
let decimal_length = length . show $ decimal
|
let decimal_length = length decimal_digits
|
||||||
let numerator = natural * (10 ^ decimal_length) + decimal
|
let numerator = natural * (10 ^ decimal_length) + decimal
|
||||||
let denominator = 10 ^ (decimal_length + natural_length - 2)
|
let denominator = 10 ^ (decimal_length + natural_length - 1)
|
||||||
return (numerator % denominator)
|
return (numerator % denominator)
|
||||||
|
|
||||||
{-
|
{-
|
||||||
|
@ -88,6 +91,11 @@ term = m_parens exprparser
|
||||||
<|> fmap Constant constantInteger
|
<|> fmap Constant constantInteger
|
||||||
<|> fmap Constant constantRational
|
<|> fmap Constant constantRational
|
||||||
|
|
||||||
|
replaceVars :: Expr -> Map.Map String Rational -> Expr
|
||||||
|
replaceVars (Variable name) vs = Constant . maybe (0 % 1) id $ Map.lookup name vs
|
||||||
|
replaceVars (Binary op a b) vs = Binary op (replaceVars a vs) (replaceVars b vs)
|
||||||
|
replaceVars (Constant c) vs = Constant c
|
||||||
|
|
||||||
evaluate :: Expr -> Rational
|
evaluate :: Expr -> Rational
|
||||||
evaluate (Constant c) = c
|
evaluate (Constant c) = c
|
||||||
evaluate (Binary Plus a b) = evaluate a + evaluate b
|
evaluate (Binary Plus a b) = evaluate a + evaluate b
|
||||||
|
|
Loading…
Reference in a new issue