diff options
Diffstat (limited to 'Parser.hs')
| -rw-r--r-- | Parser.hs | 69 |
1 files changed, 33 insertions, 36 deletions
@@ -3,7 +3,6 @@ module Parser (parseExpression) where import Control.Applicative import Control.Monad import Data.Char -import Data.Maybe import AST import Utility @@ -13,7 +12,7 @@ parseExpression :: String -> Either String AST parseExpression s = case parse pexpression s of ((node,rest):_) -> case rest of "" -> Right node - s -> Left $ "Cannot parse from '" ++ take 10 rest ++ "'" + _ -> Left $ "Cannot parse from '" ++ take 10 rest ++ "'" _ -> Left "No valid parse" @@ -50,6 +49,7 @@ mplus1 p q = Parser $ \cs -> case parse (mplus p q) cs of (x:_) -> [x] --(++) = mplus +(+++) :: Parser a -> Parser a -> Parser a (+++) = mplus1 @@ -75,8 +75,8 @@ pchar c = psat (==c) pstring :: String -> Parser String pstring "" = return "" pstring (c:cs) = do - pchar c - pstring cs + void $ pchar c + void $ pstring cs return (c:cs) pmany :: Parser a -> Parser [a] @@ -88,24 +88,16 @@ pmany1 p = do as <- pmany p return (a:as) -pinteger :: Parser Int -pinteger = do - s <- pmany $ psat isDigit - return $ read s +-- pinteger :: Parser Int +-- pinteger = do +-- s <- pmany $ psat isDigit +-- return $ read s pdouble :: Parser Double pdouble = Parser reads -pquotstring :: Parser String -pquotstring = Parser reads - -poptws :: Parser String -poptws = Parser $ pure . span isSpace - -pws :: Parser String -pws = Parser $ \s -> case span isSpace s of - ("",_) -> [] - tup@(_,_) -> [tup] +poptws :: Parser () +poptws = void $ Parser $ pure . span isSpace pword :: Parser String pword = do @@ -137,14 +129,14 @@ pinfixoperator (plus,minus) pterm sumconstr negconstr plusopt noneg = do pmoretermsplus term = do poptws - pchar plus + void $ pchar plus poptws nextterm <- pterm let thissum = sumconstr [term,nextterm] pmoreterms thissum +++ return thissum pmoretermsminus term = do poptws - pchar minus + void $ pchar minus poptws nextterm <- pterm let thissum = sumconstr [term,negconstr nextterm] @@ -170,7 +162,12 @@ pfactor :: Parser AST pfactor = pnegative +++ pfactornoneg +++ pcapture +++ pcaptureterm pnegative :: Parser AST -pnegative = do {pchar '-'; poptws; f <- pfactor; return $ Negative f} +++ pfactornoneg +pnegative = (do + void $ pchar '-' + poptws + f <- pfactor + return $ Negative f) + +++ pfactornoneg pfactornoneg :: Parser AST pfactornoneg = do @@ -179,34 +176,34 @@ pfactornoneg = do where ppower fact = do poptws - pchar '^' + void $ pchar '^' poptws fact2 <- pfactornoneg return $ Apply "pow" [fact,fact2] pfactorial fact = do poptws - pchar '!' + void $ pchar '!' return $ Apply "fact" [fact] pparenthetical :: Parser AST pparenthetical = do - pchar '(' + void $ pchar '(' poptws - sum <- psum + s <- psum poptws - pchar ')' - return sum + void $ pchar ')' + return s pfunctioncall :: Parser AST pfunctioncall = do name <- pword poptws - pchar '(' + void $ pchar '(' poptws args <- parglist poptws - pchar ')' + void $ pchar ')' return $ Apply name args where parglist = do @@ -214,7 +211,7 @@ pfunctioncall = do poptws pmoreargs arg +++ return [arg] pmoreargs arg = do - pchar ',' + void $ pchar ',' poptws args <- parglist return (arg:args) @@ -222,18 +219,18 @@ pfunctioncall = do pcapture :: Parser AST pcapture = do - pchar '[' + void $ pchar '[' name <- pmany1 $ psat (/=']') - pchar ']' + void $ pchar ']' return $ Capture name pcaptureterm :: Parser AST pcaptureterm = do - pchar '[' - pchar '[' + void $ pchar '[' + void $ pchar '[' name <- pmany1 $ psat (/=']') - pchar ']' - pchar ']' + void $ pchar ']' + void $ pchar ']' return $ CaptureTerm name pexpression :: Parser AST |