VegOwOtenks/hc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

whitespace tolerance

Browse source
This commit is contained in:
VegOwOtenks 2024-09-16 21:29:06 +02:00
parent 5bc54cd13a
commit cfc774ae56
2 changed files with 18 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
app/Main.hs
View file

@ -1,8 +1,6 @@
module Main (main) where
import Text.Parsec
import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables)
import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables, parseFullString)
import Data.Map (Map)
import qualified Data.Map as Map
@ -32,7 +30,7 @@ ioLoop vs = do done <- isEOF
if done
then putStrLn "Quit!"
else do inp <- getLine
let expr_res = parse exprparser "<stdin>" inp
let expr_res = parseFullString inp
case expr_res of
Left err -> do
putStrLn . show $ err

24
src/Lib.hs
View file

@ -1,5 +1,5 @@
module Lib
( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables
( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables, parseFullString
) where
import Control.Applicative((<*))
@ -40,11 +40,14 @@ TokenParser{ parens = m_parens
, integer = m_integer
, whiteSpace = m_whiteSpace } = makeTokenParser def
parseFullString s = parse (m_whiteSpace *> exprparser <* eof) "<stdin>" s
exprparser :: Parser Expr
exprparser = buildExpressionParser table term <?> "expression"
table = [
[
Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft,
Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft
],
[
@ -59,7 +62,9 @@ table = [
constantInteger :: Parser Rational
constantInteger = try (do
_ <- m_whiteSpace
n <- m_integer
_ <- m_whiteSpace
notFollowedBy . char $ '.'
return (n % 1)
)
@ -68,7 +73,9 @@ constantRational :: Parser Rational
constantRational = do
natural <- m_natural
_ <- char '.'
decimal_digits <- many digit
_ <- m_whiteSpace
decimal_digits <- many1 digit
_ <- m_whiteSpace
let decimal = read decimal_digits :: Integer
let natural_length = length . show $ natural
let decimal_length = length decimal_digits
@ -137,9 +144,10 @@ rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, de
evaluate :: Expr -> Rational
evaluate (Constant c) = c
evaluate (Binary Plus a b) = evaluate a + evaluate b
evaluate (Binary Minus a b) = evaluate a - evaluate b
evaluate (Binary Divide a b) = evaluate a / evaluate b
evaluate (Binary Multiply a b) = evaluate a * evaluate b
evaluate (Binary Power a b) = rationalPower (evaluate a) (evaluate b)
evaluate (Variable _) = error "Unreachable Code"
evaluate (Binary Plus a b) = evaluate a + evaluate b
evaluate (Binary Minus a b) = evaluate a - evaluate b
evaluate (Binary Divide a b) = evaluate a / evaluate b
evaluate (Binary Multiply a b) = evaluate a * evaluate b
evaluate (Binary Power a b) = rationalPower (evaluate a) (evaluate b)
evaluate (VariableDefinition _ _) = error "Unreachable Code"
evaluate (Variable _) = error "Unreachable Code"