From 1105121cc0d58497fb09fd4eafeebbd2b62e3b62 Mon Sep 17 00:00:00 2001 From: Marvin Borner Date: Wed, 2 Mar 2022 16:20:11 +0100 Subject: Fixed parsing to end --- src/Fun/Parser.hs | 78 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 43 insertions(+), 35 deletions(-) (limited to 'src/Fun/Parser.hs') diff --git a/src/Fun/Parser.hs b/src/Fun/Parser.hs index 8042caa..15c5cd0 100644 --- a/src/Fun/Parser.hs +++ b/src/Fun/Parser.hs @@ -3,10 +3,12 @@ module Fun.Parser where import Fun.Tree data Trace = StringTrace String | OrTrace [Trace] [Trace] + deriving (Eq, Show) data State = State { trace :: [Trace] , line :: Maybe String } + deriving (Eq, Show) type Parser a = String -> Either State (a, String) ---- @@ -22,26 +24,30 @@ upperAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥ isDigit :: Char -> Bool isDigit c = elem c "0123456789" +isAlpha :: Char -> Bool +isAlpha c = elem c $ lowerAlpha ++ upperAlpha + isLower :: Char -> Bool isLower c = elem c lowerAlpha isUpper :: Char -> Bool isUpper c = elem c upperAlpha -isAlpha :: Char -> Bool -isAlpha c = elem c $ lowerAlpha ++ upperAlpha - ---- char :: Parser Char char [] = Left $ State [StringTrace "char"] Nothing char (x : xs) = Right (x, xs) +endOfFile :: Parser Char +endOfFile [] = Right ('\00', []) +endOfFile _ = Left $ State [StringTrace "end of file"] Nothing + digit :: Parser Char digit = char <=> isDigit "digit" digits :: Parser String -digits = iter digit "digits" +digits = oneOrMore digit "digits" number :: Parser Integer number = @@ -55,17 +61,17 @@ number = space :: Parser Char space = char <=> (== ' ') "space" -newline :: Parser Char -newline = char <=> (== '\n') "newline" - notSpace :: Parser Char notSpace = char <=> (/= ' ') "non-space" +newline :: Parser Char +newline = char <=> (== '\n') "newline" + letter :: Parser Char letter = char <=> isAlpha "letter" letters :: Parser String -letters = iter letter "letters" +letters = oneOrMore letter "letters" alphanum :: Parser Char alphanum = digit <|> letter "letter or digit" @@ -86,28 +92,23 @@ literal c = char <=> (== c) "char (" ++ [c] ++ ")" result :: a -> Parser a result a cs = Right (a, cs) -invalid :: a -> Parser a -invalid a cs = Left $ State [StringTrace ""] $ Just "Invalid" - -iter :: Parser Char -> Parser String -iter m = (iterS m) <=> (/= "") "multiple chars" +oneOrMore :: Parser Char -> Parser String +oneOrMore m = (iter m) <=> (/= "") "one or more chars" -iterS :: Parser a -> Parser [a] -iterS m = m <+> iterS m >>> (\(x, y) -> x : y) <|> result [] "multiple" +iter :: Parser a -> Parser [a] +iter m = m <+> iter m >>> (\(x, y) -> x : y) <|> result [] "multiple" -iterFail :: Parser a -> Parser [a] -iterFail m = m <+> iterFail m >>> (\(x, y) -> x : y) +-- TODO: Improve this for better error reporting +iterFull :: Parser a -> Parser [a] +iterFull m = m <+> iterFull m >>> (\(x, y) -> x : y) <|> iterFull' +iterFull' "" = Right ([], "") +iterFull' _ = Left $ State [StringTrace ""] $ Nothing token :: Parser a -> Parser a -token = (<+-> iterS space) +token = (<+-> space) --- A parser that will accept a given alpha string -acceptWord :: String -> Parser String -acceptWord w = token (letters <=> (== w)) - --- A parser that will accept a given string accept :: String -> Parser String -accept w = token ((iter notSpace) <=> (== w)) +accept w = token ((oneOrMore notSpace) <=> (== w)) -- Given a parser and a predicate return the parser only if it satisfies the predicate infix 7 <=> @@ -181,13 +182,20 @@ infix 0 ---- tree :: Parser Tree -tree = iterFail program >>> Tree +tree = iterFull program >>> Tree program :: Parser Program -program = iterFail block >>> Program "program" +program = iterFull block >>> Program "program" block :: Parser Block -block = functionBlock <+-> newline >>> Block "block" +block = + functionBlock + <+-> newline + >>> Block + <|> functionBlock + <+-> endOfFile + >>> Block + "block" visibility :: Parser Visibility visibility = @@ -196,7 +204,7 @@ visibility = "visibility" functionBlock :: Parser FunctionBlock -functionBlock = functionDeclaration <+> iterS functionDefinition >>> build +functionBlock = functionDeclaration <+> iter functionDefinition >>> build where build (decl, defn) = FunctionBlock decl defn functionDeclaration :: Parser FunctionDeclaration @@ -241,14 +249,14 @@ functionDeclarationDelimiter = functionName :: Parser String functionName = (special <|> letter) - <+> iterS (special <|> alphanum) + <+> iter (special <|> alphanum) >>> build "function name" where build (first, rest) = first : rest functionTypes :: Parser [String] functionTypes = - iterS (functionType <+-> space <+-> functionTypeDelimiter <+-> space) + iter (functionType <+-> space <+-> functionTypeDelimiter <+-> space) <+> functionType >>> build "function types" @@ -256,7 +264,7 @@ functionTypes = functionType :: Parser String functionType = - (letter <=> isUpper) <+> iter alphanum >>> build "function type" + (letter <=> isUpper) <+> oneOrMore alphanum >>> build "function type" where build (first, rest) = first : rest functionTypeDelimiter :: Parser Char @@ -264,7 +272,7 @@ functionTypeDelimiter = literal ':' "function type delimiter" functionFlagList :: Parser [FunctionFlag] functionFlagList = - (iterS (space <-+> functionFlag)) <+-> newline >>> build "function flags" + (iter (space <-+> functionFlag)) <+-> newline >>> build "function flags" where build list = map read list functionFlagDelimiter :: Parser Char @@ -286,7 +294,7 @@ functionDefinition = functionPattern :: Parser FunctionPattern functionPattern = - iterS (functionPatternElement <+-> space) + iter (functionPatternElement <+-> space) >>> FunctionPattern "function pattern" @@ -300,12 +308,12 @@ functionPatternElement = functionParameter :: Parser String functionParameter = - letters <|> (letter <+> iter alphanum) >>> build "function parameter" + letters <|> (letter <+> oneOrMore alphanum) >>> build "function parameter" where build (a, b) = a : b functionBody :: Parser FunctionBody functionBody = - iterS (space <-+> functionBodyElement) + iter (space <-+> functionBodyElement) <+-> newline >>> FunctionBody "function body" -- cgit v1.2.3