|
|
- {
- module Presyntax.Lexer where
-
- import qualified Data.ByteString.Lazy as Lbs
- import qualified Data.Text.Encoding as T
-
- import Presyntax.Tokens
- }
-
- %wrapper "monadUserState-bytestring"
-
- $alpha = [a-zA-Z]
- $digit = [0-9]
- $white_nol = $white # \n
-
- tokens :-
- $white_nol+ ;
-
- -- zero state: normal lexing
- <0> $alpha [$alpha $digit \_ \']* { yield TokVar }
-
- <0> \= { always TokEqual }
- <0> \: { always TokColon }
- <0> \, { always TokComma }
- <0> \* { always TokStar }
-
- <0> ".1" { always TokPi1 }
- <0> ".2" { always TokPi2 }
-
- <0> \\ { always TokLambda }
- <0> "->" { always TokArrow }
-
- <0> \( { always TokOParen }
- <0> \{ { always TokOBrace }
-
- <0> \) { always TokCParen }
- <0> \} { always TokCBrace }
- <0> \; { always TokSemi }
-
- <0> \n { begin newline }
-
- -- newline: emit a semicolon when de-denting
- <newline> {
- \n ;
- () { offsideRule }
- }
-
-
- {
- alexEOF :: Alex Token
- alexEOF = do
- (AlexPn _ l c, _, _, _) <- alexGetInput
- pure $ Token TokEof l c
-
- yield k (AlexPn _ l c, _, s, _) i = pure (Token (k $! (T.decodeUtf8 (Lbs.toStrict (Lbs.take i s)))) l c)
- always k x i = yield (const k) x i
-
- data AlexUserState = AlexUserState { layoutColumns :: [Int], startCodes :: [Int] }
- alexInitUserState = AlexUserState [1] []
-
- just :: Alex a -> AlexAction Token
- just k _ _ = k *> alexMonadScan
-
- getUserState :: Alex AlexUserState
- getUserState = Alex $ \s -> Right (s, alex_ust s)
-
- mapUserState :: (AlexUserState -> AlexUserState) -> Alex ()
- mapUserState k = Alex $ \s -> Right (s { alex_ust = k $! alex_ust s }, ())
-
- pushStartCode :: Int -> Alex ()
- pushStartCode c = do
- sc <- alexGetStartCode
- mapUserState $ \s -> s { startCodes = sc:startCodes s }
- alexSetStartCode c
-
- popStartCode :: Alex ()
- popStartCode = do
- sc <- startCodes <$> getUserState
- case sc of
- [] -> alexSetStartCode 0
- (x:xs) -> do
- mapUserState $ \s -> s { startCodes = xs }
- alexSetStartCode x
-
- offsideRule :: AlexInput -> Int64 -> Alex Token
- offsideRule i@(AlexPn p line col, _, s, _) l = do
- ~(col':_) <- layoutColumns <$> getUserState
- case col `compare` col' of
- EQ -> do
- popStartCode
- pure (Token TokSemi line col)
- GT -> do
- popStartCode
- alexMonadScan
- LT -> alexError "wrong ass indentation"
- }
|