-
Notifications
You must be signed in to change notification settings - Fork 0
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
feat: Add bracketing to lexer #68
Changes from 20 commits
dd87240
1ad6d60
a5b4df9
39d101b
81b49bc
a4c47dc
93e43c6
48612d4
e4842a6
3c2be6f
16b1c85
4e9ac06
a4997dc
06f671e
063634f
c7eab1f
859a144
937ef01
4806481
48e231b
7df8f65
44e1c3e
ebf139f
625451d
6cef983
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,100 @@ | ||
module Brat.Lexer.Bracketed (BToken(..), brackets) where | ||
|
||
import Data.Bracket | ||
import Brat.Error (BracketErrMsg(..), Error(Err), ErrorMsg(..)) | ||
import Brat.FC | ||
import Brat.Lexer.Token | ||
|
||
import Data.List.NonEmpty (NonEmpty(..)) | ||
import Data.Bifunctor (first) | ||
import Text.Megaparsec (PosState(..), SourcePos(..), TraversableStream(..), VisualStream(..)) | ||
import Text.Megaparsec.Pos (mkPos) | ||
|
||
opener :: Tok -> Maybe BracketType | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I suggest
Then you can do Then zap both
Could also make |
||
opener LParen = Just Paren | ||
opener LSquare = Just Square | ||
opener LBrace = Just Brace | ||
opener _ = Nothing | ||
|
||
closer :: Tok -> Maybe BracketType | ||
closer RParen = Just Paren | ||
closer RSquare = Just Square | ||
closer RBrace = Just Brace | ||
closer _ = Nothing | ||
|
||
-- Well bracketed tokens | ||
data BToken | ||
= Bracketed FC BracketType [BToken] | ||
| FlatTok Token | ||
deriving (Eq, Ord) | ||
|
||
btokLen :: BToken -> Int | ||
btokLen (FlatTok tok) = length (show tok) | ||
btokLen (Bracketed _ _ bs) = sum (btokLen <$> bs) + 2 | ||
|
||
instance Show BToken where | ||
show (FlatTok t) = show t | ||
show (Bracketed _ b ts) = showOpen b ++ show ts ++ showClose b | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Or use There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Ok, so I realize you can't |
||
|
||
instance VisualStream [BToken] where | ||
showTokens _ = concatMap show | ||
tokensLength _ = sum . fmap btokLen | ||
|
||
instance TraversableStream [BToken] where | ||
reachOffsetNoLine i pos = let fileName = sourceName (pstateSourcePos pos) | ||
(Pos line col, rest) = skipChars (i - pstateOffset pos + 1) (pstateInput pos) | ||
in pos | ||
{ pstateInput = rest | ||
, pstateOffset = max (pstateOffset pos) i | ||
, pstateSourcePos = SourcePos fileName (mkPos line) (mkPos col) | ||
} | ||
where | ||
skipChars :: Int -> [BToken] -> (Pos, [BToken]) | ||
skipChars 0 inp@(Bracketed fc _ _:_) = (start fc, inp) | ||
Check warning on line 53 in brat/Brat/Lexer/Bracketed.hs GitHub Actions / build
|
||
skipChars 0 inp@(FlatTok t:_) = (start (fc t), inp) | ||
skipChars i ((Bracketed fc b bts):rest) = | ||
let Pos closeLine closeCol = end fc | ||
closeFC = FC (Pos closeLine (closeCol - 1)) (Pos closeLine closeCol) | ||
in skipChars (i - 1) (bts ++ [FlatTok (Token closeFC (closeTok b))] ++ rest) | ||
skipChars i (FlatTok t:rest) | ||
| i >= tokenLen t = skipChars (i - tokenLen t) rest | ||
| otherwise = (start (fc t), FlatTok t:rest) | ||
|
||
closeTok Paren = RParen | ||
closeTok Square = RSquare | ||
closeTok Brace = RBrace | ||
|
||
eofErr :: FC -> BracketType -> Error | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I think I suggested you curry this earlier and now I'm gonna make the reverse suggestion - sorry! But the "unit" of bracket, in There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I don't think I'm really getting it, but have uncurried anyway |
||
eofErr fc b = Err (Just fc) (BracketErr (EOFInBracket b)) | ||
|
||
openCloseMismatchErr :: (FC, BracketType) -> (FC, BracketType) -> Error | ||
openCloseMismatchErr open (fcClose, bClose) | ||
= Err (Just fcClose) (BracketErr (OpenCloseMismatch open bClose)) | ||
|
||
unexpectedCloseErr :: FC -> BracketType -> Error | ||
unexpectedCloseErr fc b = Err (Just fc) (BracketErr (UnexpectedClose b)) | ||
|
||
brackets :: [Token] -> Either Error [BToken] | ||
brackets ts = helper ts >>= \case | ||
(res, Nothing) -> pure res | ||
(_, Just (b, t:|_)) -> Left $ unexpectedCloseErr (fc t) b | ||
where | ||
-- Given a list of tokens, either | ||
-- (success) return [BToken] consisting of the prefix of the input [Token] in which all opened brackets are closed, | ||
-- and any remaining [Token] beginning with a closer that does not match any opener in the input | ||
-- (either Nothing = no remaining tokens; or tokens with the BracketType that the first token closes) | ||
-- (failure) return an error, if a bracket opened in the input, is either not closed (EOF) or does not match the closer | ||
helper :: [Token] -> Either Error ([BToken], Maybe (BracketType, NonEmpty Token)) | ||
helper [] = pure ([], Nothing) | ||
helper (t:ts) | ||
| Just b <- opener (_tok t) = let openFC = fc t in helper ts >>= \case | ||
(_, Nothing) -> Left $ eofErr openFC b | ||
(within, Just (b', r :| rs)) -> | ||
let closeFC = fc r | ||
enclosingFC = spanFC openFC closeFC | ||
in if b == b' then | ||
first (Bracketed enclosingFC b within:) <$> helper rs | ||
else | ||
Left $ openCloseMismatchErr (openFC, b) (closeFC, b') | ||
| Just b <- closer (_tok t) = pure ([], Just (b, t :| ts)) -- return closer for caller | ||
| otherwise = first (FlatTok t:) <$> helper ts |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
This is pretty much an OpenCloseMismatch, without an opening (or where the opening is beginning of file) - consider combining the two, i.e.
OpenCloseMismatch (Maybe (FC, BracketType)) BracketType
. Or not, the conceptual similarity could just be confusing, up to you...