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

{
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
[email protected](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
}