|
|
- {
- 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
- }
|