From ae39579c979aac2682dea941dda6f83bba64afda Mon Sep 17 00:00:00 2001 From: crumbtoo Date: Wed, 22 Nov 2023 15:38:15 -0700 Subject: [PATCH] location (row,col) -> span (row,col,len) --- src/Compiler/RLPC.hs | 2 +- src/Core/Lex.x | 44 +++++++++++++++++++------------------- src/Core/Parse.y | 50 ++++++++++++++++++++++---------------------- 3 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/Compiler/RLPC.hs b/src/Compiler/RLPC.hs index 2896f5a..c56333e 100644 --- a/src/Compiler/RLPC.hs +++ b/src/Compiler/RLPC.hs @@ -42,7 +42,7 @@ evalRLPC o m = coerce $ evalRLPCT o m data RLPCOptions = RLPCOptions data SrcError e = SrcError - { _errLocation :: (Int, Int) + { _errSpan :: (Int, Int, Int) , _errSeverity :: Severity , _errDiagnostic :: e } diff --git a/src/Core/Lex.x b/src/Core/Lex.x index 05700aa..8d2fc8b 100644 --- a/src/Core/Lex.x +++ b/src/Core/Lex.x @@ -135,11 +135,11 @@ $white_no_nl+ { skip } } { -data Located a = Located AlexPosn a +data Located a = Located Int Int Int a deriving Show constTok :: t -> AlexInput -> Int -> Alex (Located t) -constTok t (p,_,_,_) _ = pure $ Located p t +constTok t (AlexPn _ y x,_,_,_) l = pure $ Located x y l t data CoreToken = TokenLet | TokenLetrec @@ -210,16 +210,16 @@ lexStream :: Alex [Located CoreToken] lexStream = do l <- alexMonadScan case l of - Located _ TokenEOF -> pure [l] - _ -> (l:) <$> lexStream + Located _ _ _ TokenEOF -> pure [l] + _ -> (l:) <$> lexStream -- | The main lexer driver. lexCore :: String -> RLPC ParseError [Located CoreToken] lexCore s = case m of Left e -> addFatal err where err = SrcError - { _errLocation = (0,0) -- TODO: location - , _errSeverity = Error + { _errSpan = (0,0,0) -- TODO: location + , _errSeverity = Error , _errDiagnostic = ParErrLexical e } Right ts -> pure ts @@ -230,14 +230,14 @@ lexCore s = case m of -- debugging lexCore' :: String -> RLPC ParseError [CoreToken] lexCore' s = fmap f <$> lexCore s - where f (Located _ t) = t + where f (Located _ _ _ t) = t data ParseError = ParErrLexical String | ParErrParse deriving Show lexWith :: (String -> CoreToken) -> Lexer -lexWith f (p,_,_,s) l = pure $ Located p (f $ take l s) +lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located x y l (f $ take l s) lexToken :: Alex (Located CoreToken) lexToken = alexMonadScan @@ -248,23 +248,23 @@ getSrcCol = Alex $ \ st -> in Right (st, col) lbrace :: Lexer -lbrace (p,_,_,_) _ = do +lbrace (AlexPn _ y x,_,_,_) l = do pushContext NoLayout - pure $ Located p TokenLBrace + pure $ Located x y l TokenLBrace rbrace :: Lexer -rbrace (p,_,_,_) _ = do +rbrace (AlexPn _ y x,_,_,_) l = do popContext - pure $ Located p TokenRBrace + pure $ Located x y l TokenRBrace insRBraceV :: AlexPosn -> Alex (Located CoreToken) -insRBraceV p = do +insRBraceV (AlexPn _ y x) = do popContext - pure $ Located p TokenRBraceV + pure $ Located x y 0 TokenRBraceV insSemi :: AlexPosn -> Alex (Located CoreToken) -insSemi p = do - pure $ Located p TokenSemicolon +insSemi (AlexPn _ y x) = do + pure $ Located x y 0 TokenSemicolon modifyUst :: (AlexUserState -> AlexUserState) -> Alex () modifyUst f = do @@ -279,10 +279,10 @@ newLayoutContext (p,_,_,_) _ = do undefined noBrace :: Lexer -noBrace (p,_,_,_) l = do +noBrace (AlexPn _ y x,_,_,_) l = do col <- getSrcCol pushContext (Layout col) - pure $ Located p TokenLBraceV + pure $ Located x y l TokenLBraceV getOffside :: Alex Ordering getOffside = do @@ -301,15 +301,15 @@ doBol (p,c,_,s) _ = do _ -> lexToken letin :: Lexer -letin (p,_,_,_) l = do +letin (AlexPn _ y x,_,_,_) l = do popContext - pure $ Located p TokenIn + pure $ Located x y l TokenIn topLevelOff :: Lexer topLevelOff = noBrace alexEOF :: Alex (Located CoreToken) -alexEOF = Alex $ \ st@(AlexState { alex_pos = p }) -> - Right (st, Located p TokenEOF) +alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) -> + Right (st, Located x y 0 TokenEOF) } diff --git a/src/Core/Parse.y b/src/Core/Parse.y index 22859b5..ee93323 100644 --- a/src/Core/Parse.y +++ b/src/Core/Parse.y @@ -26,28 +26,28 @@ import Compiler.RLPC %monad { RLPC ParseError } %token - let { Located _ TokenLet } - letrec { Located _ TokenLetrec } - module { Located _ TokenModule } - where { Located _ TokenWhere } - ',' { Located _ TokenComma } - in { Located _ TokenIn } - litint { Located _ (TokenLitInt $$) } - varname { Located _ (TokenVarName $$) } - varsym { Located _ (TokenVarSym $$) } - conname { Located _ (TokenConName $$) } - consym { Located _ (TokenConSym $$) } - 'λ' { Located _ TokenLambda } - '->' { Located _ TokenArrow } - '=' { Located _ TokenEquals } - '(' { Located _ TokenLParen } - ')' { Located _ TokenRParen } - '{' { Located _ TokenLBrace } - '}' { Located _ TokenRBrace } - vl { Located _ TokenLBraceV } - vr { Located _ TokenRBraceV } - ';' { Located _ TokenSemicolon } - eof { Located _ TokenEOF } + let { Located _ _ _ TokenLet } + letrec { Located _ _ _ TokenLetrec } + module { Located _ _ _ TokenModule } + where { Located _ _ _ TokenWhere } + ',' { Located _ _ _ TokenComma } + in { Located _ _ _ TokenIn } + litint { Located _ _ _ (TokenLitInt $$) } + varname { Located _ _ _ (TokenVarName $$) } + varsym { Located _ _ _ (TokenVarSym $$) } + conname { Located _ _ _ (TokenConName $$) } + consym { Located _ _ _ (TokenConSym $$) } + 'λ' { Located _ _ _ TokenLambda } + '->' { Located _ _ _ TokenArrow } + '=' { Located _ _ _ TokenEquals } + '(' { Located _ _ _ TokenLParen } + ')' { Located _ _ _ TokenRParen } + '{' { Located _ _ _ TokenLBrace } + '}' { Located _ _ _ TokenRBrace } + vl { Located _ _ _ TokenLBraceV } + vr { Located _ _ _ TokenRBraceV } + ';' { Located _ _ _ TokenSemicolon } + eof { Located _ _ _ TokenEOF } %% @@ -138,10 +138,10 @@ Con : '(' consym ')' { $2 } { parseError :: [Located CoreToken] -> RLPC ParseError a -parseError (Located (AlexPn _ x y) _ : _) = addFatal err +parseError (Located x y l _ : _) = addFatal err where err = SrcError - { _errLocation = (x, y) - , _errSeverity = Error + { _errSpan = (x, y, l) + , _errSeverity = Error , _errDiagnostic = ParErrParse }