{ 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 } { -- Skip comments and whitespace "--" .* \n ; \n ; \{ { openBrace } () { startLayout } } () { emptyLayout } { \n ; "--" .* \n ; () { offsideRule } } () { 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 }