Code accompanying
https://abby.how/posts/parsing-layout.html
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
130 lines
2.4 KiB
130 lines
2.4 KiB
{
|
|
module Lexer where
|
|
|
|
import Control.Monad.State
|
|
import Control.Monad.Error
|
|
import Lexer.Support
|
|
|
|
import Debug.Trace
|
|
|
|
}
|
|
|
|
%encoding "latin1"
|
|
|
|
$lower = [ a-z ]
|
|
$upper = [ A-Z ]
|
|
|
|
@ident = $lower [ $lower $upper _ ' ]*
|
|
|
|
:-
|
|
[\ \t]+ ;
|
|
|
|
<0> "in" { token TkIn }
|
|
<0> "let" { layoutKw TkLet }
|
|
<0> "where" { layoutKw TkWhere }
|
|
|
|
<0> @ident { emit TkIdent }
|
|
<0> \\ { token TkBackslash }
|
|
<0> "->" { token TkArrow }
|
|
<0> \= { token TkEqual }
|
|
<0> \( { token TkLParen }
|
|
<0> \) { token TkRParen }
|
|
<0> \{ { token TkOpen }
|
|
<0> \} { token TkClose }
|
|
|
|
|
|
<0> "--" .* \n { \_ -> pushStartCode newline *> scan }
|
|
<0> \n { \_ -> pushStartCode newline *> scan }
|
|
|
|
<layout> {
|
|
-- Skip comments and whitespace
|
|
"--" .* \n ;
|
|
\n ;
|
|
|
|
\{ { openBrace }
|
|
() { startLayout }
|
|
}
|
|
|
|
<empty_layout> () { emptyLayout }
|
|
|
|
<newline> {
|
|
\n ;
|
|
"--" .* \n ;
|
|
|
|
() { offsideRule }
|
|
}
|
|
|
|
<eof> () { doEOF }
|
|
|
|
{
|
|
handleEOF = pushStartCode eof *> scan
|
|
|
|
doEOF _ = do
|
|
t <- Lexer.Support.layout
|
|
case t of
|
|
Nothing -> do
|
|
popStartCode
|
|
pure TkEOF
|
|
_ -> do
|
|
popLayout
|
|
pure TkVClose
|
|
|
|
scan :: Lexer Token
|
|
scan = do
|
|
input@(Input _ _ _ string) <- gets lexerInput
|
|
startcode <- startCode
|
|
case alexScan input startcode of
|
|
AlexEOF -> handleEOF
|
|
AlexError (Input _ _ _ inp) ->
|
|
throwError $ "Lexical error: " ++ show (head inp)
|
|
AlexSkip input' _ -> do
|
|
modify' $ \s -> s { lexerInput = input' }
|
|
scan
|
|
AlexToken input' tokl action -> do
|
|
modify' $ \s -> s { lexerInput = input' }
|
|
action (take tokl string)
|
|
|
|
layoutKw t _ = do
|
|
pushStartCode Lexer.layout
|
|
pure t
|
|
|
|
openBrace _ = do
|
|
popStartCode
|
|
pushLayout ExplicitLayout
|
|
pure TkOpen
|
|
|
|
startLayout _ = do
|
|
popStartCode
|
|
|
|
reference <- Lexer.Support.layout
|
|
col <- gets (inpColumn . lexerInput)
|
|
|
|
if Just (LayoutColumn col) <= reference
|
|
then pushStartCode empty_layout
|
|
else pushLayout (LayoutColumn col)
|
|
|
|
pure TkVOpen
|
|
|
|
emptyLayout _ = do
|
|
popStartCode
|
|
pushStartCode newline
|
|
pure TkVClose
|
|
|
|
offsideRule _ = do
|
|
context <- Lexer.Support.layout
|
|
col <- gets (inpColumn . lexerInput)
|
|
|
|
let continue = popStartCode *> scan
|
|
|
|
case context of
|
|
Just (LayoutColumn col') -> do
|
|
case col `compare` col' of
|
|
EQ -> do
|
|
popStartCode
|
|
pure TkVSemi
|
|
GT -> continue
|
|
LT -> do
|
|
popLayout
|
|
pure TkVClose
|
|
_ -> continue
|
|
}
|