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.
96 lines
2.5 KiB
96 lines
2.5 KiB
{
|
|
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"
|
|
}
|