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

12
src/Lib.hs
View file

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