msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

location (row,col) -> span (row,col,len)

Browse Source
This commit is contained in:
crumbtoo
2023-11-22 15:38:15 -07:00
parent 26c135cccb
commit ae39579c97
3 changed files with 48 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/Compiler/RLPC.hs
View File

@@ -42,7 +42,7 @@ evalRLPC o m = coerce $ evalRLPCT o m
data RLPCOptions = RLPCOptions data RLPCOptions = RLPCOptions
data SrcError e = SrcError data SrcError e = SrcError
{ _errLocation :: (Int, Int) { _errSpan :: (Int, Int, Int)
, _errSeverity :: Severity , _errSeverity :: Severity
, _errDiagnostic :: e , _errDiagnostic :: e
} }

44
src/Core/Lex.x
View File

@@ -135,11 +135,11 @@ $white_no_nl+ { skip }
} }
{ {
data Located a = Located AlexPosn a data Located a = Located Int Int Int a
deriving Show deriving Show
constTok :: t -> AlexInput -> Int -> Alex (Located t) 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 data CoreToken = TokenLet
| TokenLetrec | TokenLetrec
@@ -210,16 +210,16 @@ lexStream :: Alex [Located CoreToken]
lexStream = do lexStream = do
l <- alexMonadScan l <- alexMonadScan
case l of case l of
Located _ TokenEOF -> pure [l] Located _ _ _ TokenEOF -> pure [l]
_ -> (l:) <$> lexStream _ -> (l:) <$> lexStream
-- | The main lexer driver. -- | The main lexer driver.
lexCore :: String -> RLPC ParseError [Located CoreToken] lexCore :: String -> RLPC ParseError [Located CoreToken]
lexCore s = case m of lexCore s = case m of
Left e -> addFatal err Left e -> addFatal err
where err = SrcError where err = SrcError
{ _errLocation = (0,0) -- TODO: location { _errSpan = (0,0,0) -- TODO: location
, _errSeverity = Error , _errSeverity = Error
, _errDiagnostic = ParErrLexical e , _errDiagnostic = ParErrLexical e
} }
Right ts -> pure ts Right ts -> pure ts
@@ -230,14 +230,14 @@ lexCore s = case m of
-- debugging -- debugging
lexCore' :: String -> RLPC ParseError [CoreToken] lexCore' :: String -> RLPC ParseError [CoreToken]
lexCore' s = fmap f <$> lexCore s lexCore' s = fmap f <$> lexCore s
where f (Located _ t) = t where f (Located _ _ _ t) = t
data ParseError = ParErrLexical String data ParseError = ParErrLexical String
| ParErrParse | ParErrParse
deriving Show deriving Show
lexWith :: (String -> CoreToken) -> Lexer 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 :: Alex (Located CoreToken)
lexToken = alexMonadScan lexToken = alexMonadScan
@@ -248,23 +248,23 @@ getSrcCol = Alex $ \ st ->
in Right (st, col) in Right (st, col)
lbrace :: Lexer lbrace :: Lexer
lbrace (p,_,_,_) _ = do lbrace (AlexPn _ y x,_,_,_) l = do
pushContext NoLayout pushContext NoLayout
pure $ Located p TokenLBrace pure $ Located x y l TokenLBrace
rbrace :: Lexer rbrace :: Lexer
rbrace (p,_,_,_) _ = do rbrace (AlexPn _ y x,_,_,_) l = do
popContext popContext
pure $ Located p TokenRBrace pure $ Located x y l TokenRBrace
insRBraceV :: AlexPosn -> Alex (Located CoreToken) insRBraceV :: AlexPosn -> Alex (Located CoreToken)
insRBraceV p = do insRBraceV (AlexPn _ y x) = do
popContext popContext
pure $ Located p TokenRBraceV pure $ Located x y 0 TokenRBraceV
insSemi :: AlexPosn -> Alex (Located CoreToken) insSemi :: AlexPosn -> Alex (Located CoreToken)
insSemi p = do insSemi (AlexPn _ y x) = do
pure $ Located p TokenSemicolon pure $ Located x y 0 TokenSemicolon
modifyUst :: (AlexUserState -> AlexUserState) -> Alex () modifyUst :: (AlexUserState -> AlexUserState) -> Alex ()
modifyUst f = do modifyUst f = do
@@ -279,10 +279,10 @@ newLayoutContext (p,_,_,_) _ = do
undefined undefined
noBrace :: Lexer noBrace :: Lexer
noBrace (p,_,_,_) l = do noBrace (AlexPn _ y x,_,_,_) l = do
col <- getSrcCol col <- getSrcCol
pushContext (Layout col) pushContext (Layout col)
pure $ Located p TokenLBraceV pure $ Located x y l TokenLBraceV
getOffside :: Alex Ordering getOffside :: Alex Ordering
getOffside = do getOffside = do
@@ -301,15 +301,15 @@ doBol (p,c,_,s) _ = do
_ -> lexToken _ -> lexToken
letin :: Lexer letin :: Lexer
letin (p,_,_,_) l = do letin (AlexPn _ y x,_,_,_) l = do
popContext popContext
pure $ Located p TokenIn pure $ Located x y l TokenIn
topLevelOff :: Lexer topLevelOff :: Lexer
topLevelOff = noBrace topLevelOff = noBrace
alexEOF :: Alex (Located CoreToken) alexEOF :: Alex (Located CoreToken)
alexEOF = Alex $ \ st@(AlexState { alex_pos = p }) -> alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) ->
Right (st, Located p TokenEOF) Right (st, Located x y 0 TokenEOF)
} }

50
src/Core/Parse.y
View File

@@ -26,28 +26,28 @@ import Compiler.RLPC
%monad { RLPC ParseError } %monad { RLPC ParseError }
%token %token
let { Located _ TokenLet } let { Located _ _ _ TokenLet }
letrec { Located _ TokenLetrec } letrec { Located _ _ _ TokenLetrec }
module { Located _ TokenModule } module { Located _ _ _ TokenModule }
where { Located _ TokenWhere } where { Located _ _ _ TokenWhere }
',' { Located _ TokenComma } ',' { Located _ _ _ TokenComma }
in { Located _ TokenIn } in { Located _ _ _ TokenIn }
litint { Located _ (TokenLitInt $$) } litint { Located _ _ _ (TokenLitInt $$) }
varname { Located _ (TokenVarName $$) } varname { Located _ _ _ (TokenVarName $$) }
varsym { Located _ (TokenVarSym $$) } varsym { Located _ _ _ (TokenVarSym $$) }
conname { Located _ (TokenConName $$) } conname { Located _ _ _ (TokenConName $$) }
consym { Located _ (TokenConSym $$) } consym { Located _ _ _ (TokenConSym $$) }
'λ' { Located _ TokenLambda } 'λ' { Located _ _ _ TokenLambda }
'->' { Located _ TokenArrow } '->' { Located _ _ _ TokenArrow }
'=' { Located _ TokenEquals } '=' { Located _ _ _ TokenEquals }
'(' { Located _ TokenLParen } '(' { Located _ _ _ TokenLParen }
')' { Located _ TokenRParen } ')' { Located _ _ _ TokenRParen }
'{' { Located _ TokenLBrace } '{' { Located _ _ _ TokenLBrace }
'}' { Located _ TokenRBrace } '}' { Located _ _ _ TokenRBrace }
vl { Located _ TokenLBraceV } vl { Located _ _ _ TokenLBraceV }
vr { Located _ TokenRBraceV } vr { Located _ _ _ TokenRBraceV }
';' { Located _ TokenSemicolon } ';' { Located _ _ _ TokenSemicolon }
eof { Located _ TokenEOF } eof { Located _ _ _ TokenEOF }
%% %%
@@ -138,10 +138,10 @@ Con : '(' consym ')' { $2 }
{ {
parseError :: [Located CoreToken] -> RLPC ParseError a parseError :: [Located CoreToken] -> RLPC ParseError a
parseError (Located (AlexPn _ x y) _ : _) = addFatal err parseError (Located x y l _ : _) = addFatal err
where err = SrcError where err = SrcError
{ _errLocation = (x, y) { _errSpan = (x, y, l)
, _errSeverity = Error , _errSeverity = Error
, _errDiagnostic = ParErrParse , _errDiagnostic = ParErrParse
} }