diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,3 +5,11 @@ _2023-05-06, Sebastian Tee_ Initial version + +### 1.0.0 + +_2023-07-08, Sebastian Tee_ + +Rename TokenSyntax to GrammarRule + +Add Error GrammarRule diff --git a/hlex.cabal b/hlex.cabal --- a/hlex.cabal +++ b/hlex.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: hlex -version: 0.1.0 +version: 1.0.0 synopsis: Simple Lexer Creation description: This package provides the tools to create a simple lexer. category: lexer diff --git a/src/Hlex.hs b/src/Hlex.hs --- a/src/Hlex.hs +++ b/src/Hlex.hs @@ -12,7 +12,7 @@ -- * Types Grammar - , TokenSyntax(..) + , GrammarRule(..) , Lexer -- ** Exceptions , LexException(..) @@ -21,18 +21,25 @@ ) where import Text.Regex.TDFA ((=~)) +import Data.Maybe (maybeToList) --- | Exception thrown when a 'Lexer' is unable to lex a string. -data LexException = LexException - Int -- ^ The line number where the string that couldn't be lexed is located. - Int -- ^ The column where the string that couldn't be lexed is located. - String -- ^ The String that couldn't be lexed. +-- | Exception thrown when a 'Lexer' encounters an error when lexxing a string. +data LexException + = UnmatchedException -- ^ Exception thrown when a substring cannot be matched. + Int -- ^ The line number where the substring that couldn't be lexed is located. + Int -- ^ The column where the substring that couldn't be lexed is located. + String -- ^ The subtring that couldn't be lexed. + | MatchedException -- ^ Exception thrown when a macth is found on the 'Error' 'GrammarRule'. + Int -- ^ The line number where the matched string is located. + Int -- ^ The column where the matched string is located. + String -- ^ The matched string. + String -- ^ Error message. deriving(Read, Show, Eq) -- | These are the individual rules that make up a 'Grammar'. -- -- Takes a __POSIX regular expression__ then converts it to a token or skips it. -data TokenSyntax token +data GrammarRule token = Skip -- ^ Skips over any matches. String -- ^ Regular expression. | Tokenize -- ^ Takes a function that converts the matched string to a token. @@ -41,43 +48,40 @@ | JustToken -- ^ Converts any regular expression matches to a given token. String -- ^ Regular expression. token -- ^ Given token. - -type InternalToken token = (String, Maybe (String -> token)) + | Error -- ^ Returns an error with a message when a match occurs. + String -- ^ Regular expression. + String -- ^ Error message. --- | Lexical grammar made up of 'TokenSyntax' rules. +-- | Lexical grammar made up of 'GrammarRule's. -- --- The __order is important__. The 'Lexer' will apply each 'TokenSyntax' rule in the order listed. -type Grammar token = [TokenSyntax token] +-- The __order is important__. The 'Lexer' will apply each 'GrammarRule' rule in the order listed. +type Grammar token = [GrammarRule token] -- | Converts a string into a list of tokens. -- If the string does not follow the Lexer's 'Grammar' a 'LexException' will be returned. type Lexer token = String -> Either LexException [token] -tokenizerToInternalToken :: TokenSyntax a -> InternalToken a -tokenizerToInternalToken (Skip regex) = (regex, Nothing) -tokenizerToInternalToken (Tokenize regex toToken) = (regex, Just toToken) -tokenizerToInternalToken (JustToken regex token) = (regex, Just $ \_ -> token) - -- | Takes a given 'Grammar' and turns it into a 'Lexer'. hlex :: Grammar token -> Lexer token -hlex = lexInternal 1 1 . map tokenizerToInternalToken +hlex = hlex' 1 1 -lexInternal :: Int -> Int -> [InternalToken token] -> Lexer token -lexInternal _ _ _ "" = Right [] -lexInternal row col ((regex, t):grammar) program = if null matchedText - then lexInternal row col grammar program - else do - before <- parsedBefore - after <- parsedAfter - case t of - Nothing -> Right $ before ++ after - Just tk -> Right $ before ++ tk matchedText : after +hlex' :: Int -> Int -> Grammar token -> Lexer token +hlex' _ _ _ [] = Right [] +hlex' row col tzss@(tz:tzs) program = + if null matchedText + then hlex' row col tzs program + else case tz of + Error _ errMessage -> Left $ uncurry MatchedException (getLastCharPos row col beforeProgram) matchedText errMessage + Skip _ -> lexCont Nothing + Tokenize _ f -> lexCont $ Just $ f matchedText + JustToken _ token -> lexCont $ Just token where - (beforeProgram, matchedText, afterProgram) = program =~ regex :: (String, String, String) - (afterRow, afterCol) = getLastCharPos row col (beforeProgram ++ matchedText) - parsedBefore = lexInternal row col grammar beforeProgram - parsedAfter = lexInternal afterRow afterCol ((regex, t):grammar) afterProgram -lexInternal row col _ invalidString = Left $ LexException row col invalidString + (beforeProgram, matchedText, afterProgram) = program =~ getRegex tz :: (String, String, String) + lexCont t = do + before <- hlex' row col tzs beforeProgram + after <- uncurry hlex' (getLastCharPos row col (beforeProgram ++ matchedText)) tzss afterProgram + Right $ before ++ maybeToList t ++ after +hlex' row col _ invalidString = Left $ UnmatchedException row col invalidString getLastCharPos :: Int -> Int -> String -> (Int, Int) getLastCharPos startRow startCol x = (startRow + addRow, addCol + if addRow == 0 then startCol else 1) @@ -86,6 +90,12 @@ addRow = length ls - 1 addCol = length $ last ls +getRegex :: GrammarRule token -> String +getRegex (Skip regex) = regex +getRegex (Tokenize regex _) = regex +getRegex (JustToken regex _) = regex +getRegex (Error regex _) = regex + {- $example Here is an example module for a simple language. @@ -103,7 +113,9 @@ deriving(Show) myGrammar :: Grammar MyToken - myGrammar = [ JustToken "=" Assign -- "=" Operator becomes the assign token + myGrammar = [ Error "\"[^\"]*\n" "Can't have a new line in a string" -- Return Exception when a new line occurs in a string + , Tokenize "\"[^\"]*\"" $ Str . init . tail -- Encode string and strip the containing quotes + , JustToken "=" Assign -- "=" Operator becomes the assign token , Tokenize "[a-zA-Z]+" (\match -> Ident match) -- Identifier token with string , Tokenize "[0-9]+(\\.[0-9]+)?" (\match -> Number (read match) -- Number token with the parsed numeric value stored as a Float , Skip "[ \\n\\r\\t]+" -- Skip whitespace @@ -117,6 +129,11 @@ >>> lexer "x = 1.2" Right [Ident "x", Assign, Number 1.2] + +Here is the lexer being used on an program with a syntax error. + +>>> lexer "x = \"a\nb\"" +Left (MatchedException 1 5 "\"a\n" "Can't have a new line in a string") The lexer uses 'Either'. Right means the lexer successfully parsed the program to a list of MyTokens. If Left was returned it would be a 'LexException'. diff --git a/test/ExampleLang.hs b/test/ExampleLang.hs --- a/test/ExampleLang.hs +++ b/test/ExampleLang.hs @@ -6,12 +6,15 @@ import Hlex data Token = Ident String + | Str String | Number Float | Assign deriving(Read, Show, Eq) grammar :: Grammar Token -grammar = [ JustToken "=" Assign +grammar = [ Error "\"[^\"]*\n" "Can't have a new line in a string" + , Tokenize "\"[^\"]*\"" $ Str . init . tail + , JustToken "=" Assign , Tokenize "[a-zA-Z]+" Ident , Tokenize "[0-9]+(\\.[0-9]+)?" $ Number . read , Skip "[ \n\r\t]+" diff --git a/test/Exceptions.hs b/test/Exceptions.hs --- a/test/Exceptions.hs +++ b/test/Exceptions.hs @@ -8,10 +8,14 @@ exceptions :: Test exceptions = TestList [ TestLabel "Location Exception" exceptionLocation , TestLabel "Number Parse Exception" exceptionNumParse + , TestLabel "String Parse Exception" exceptionStrParse ] exceptionLocation :: Test -exceptionLocation = TestCase $ assertLexException lexer "aaaa\n\naaaaa\naaa\naaa//bbbaa\naaaaa" $ LexException 5 4 "//" +exceptionLocation = TestCase $ assertLexException lexer "aaaa\n\naaaaa\naaa\naaa//bbbaa\naaaaa" $ UnmatchedException 5 4 "//" exceptionNumParse :: Test -exceptionNumParse = TestCase $ assertLexException lexer "10.2.3" $ LexException 1 5 "." +exceptionNumParse = TestCase $ assertLexException lexer "10.2.3" $ UnmatchedException 1 5 "." + +exceptionStrParse :: Test +exceptionStrParse = TestCase $ assertLexException lexer "\nab\"cd\n\"ef" $ MatchedException 2 3 "\"cd\n" "Can't have a new line in a string" diff --git a/test/Successes.hs b/test/Successes.hs --- a/test/Successes.hs +++ b/test/Successes.hs @@ -7,6 +7,7 @@ successes :: Test successes = TestList [ TestLabel "Parse Number" parseNum , TestLabel "Assign Number" assignNumber + , TestLabel "Assign String" assignStr ] parseNum :: Test @@ -14,3 +15,6 @@ assignNumber :: Test assignNumber = TestCase $ assertLexResult lexer "x = 1" [Ident "x", Assign, Number 1] + +assignStr :: Test +assignStr = TestCase $ assertLexResult lexer "x = \"ab\"" [Ident "x", Assign, Str "ab"]