module Lexers (Regexp, Lexer, Action, epsilon, char, (+>), lexaction,
lexactionErr, lexmeta, (>|<), (>||<), ctrlChars, ctrlLexer,
star, plus, quest, alt, string, LexerState, execLexer)
where
import Data.Maybe (fromMaybe, isNothing)
import Data.Array (Ix(..), Array, array, (!), assocs, accumArray)
import Position (Position(..), Pos (posOf), nopos, incPos, tabPos, retPos)
import DLists (DList, openDL, zeroDL, unitDL, snocDL, joinDL, closeDL)
import Errors (interr, ErrorLvl(..), Error, makeError)
infixr 4 `quest`, `star`, `plus`
infixl 3 +>, `lexaction`, `lexmeta`
infixl 2 >|<, >||<
denseMin :: Int
denseMin :: Int
denseMin = 20
type BoundsNum = (Int, Char, Char)
nullBoundsNum :: BoundsNum
nullBoundsNum :: BoundsNum
nullBoundsNum = (0, Char
forall a. Bounded a => a
maxBound, Char
forall a. Bounded a => a
minBound)
addBoundsNum :: BoundsNum -> BoundsNum -> BoundsNum
addBoundsNum :: BoundsNum -> BoundsNum -> BoundsNum
addBoundsNum (n :: Int
n, lc :: Char
lc, hc :: Char
hc) (n' :: Int
n', lc' :: Char
lc', hc' :: Char
hc') = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n', Char -> Char -> Char
forall a. Ord a => a -> a -> a
min Char
lc Char
lc', Char -> Char -> Char
forall a. Ord a => a -> a -> a
max Char
hc Char
hc')
inBounds :: Char -> BoundsNum -> Bool
inBounds :: Char -> BoundsNum -> Bool
inBounds c :: Char
c (_, lc :: Char
lc, hc :: Char
hc) = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
lc Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
hc
type Action t = String -> Position -> Maybe t
type ActionErr t = String -> Position -> Either Error t
type Meta s t = String -> Position -> s -> (Maybe (Either Error t),
Position,
s,
Maybe (Lexer s t))
data Lexer s t = Lexer (LexAction s t) (Cont s t)
data Cont s t =
Dense BoundsNum (Array Char (Lexer s t))
| Sparse BoundsNum [(Char, Lexer s t)]
| Done
data LexAction s t = Action (Meta s t)
| NoAction
type Regexp s t = Lexer s t -> Lexer s t
epsilon :: Regexp s t
epsilon :: Regexp s t
epsilon = Regexp s t
forall a. a -> a
id
char :: Char -> Regexp s t
char :: Char -> Regexp s t
char c :: Char
c = \l :: Lexer s t
l -> LexAction s t -> Cont s t -> Lexer s t
forall s t. LexAction s t -> Cont s t -> Lexer s t
Lexer LexAction s t
forall s t. LexAction s t
NoAction (BoundsNum -> [(Char, Lexer s t)] -> Cont s t
forall s t. BoundsNum -> [(Char, Lexer s t)] -> Cont s t
Sparse (1, Char
c, Char
c) [(Char
c, Lexer s t
l)])
(+>) :: Regexp s t -> Regexp s t -> Regexp s t
+> :: Regexp s t -> Regexp s t -> Regexp s t
(+>) = Regexp s t -> Regexp s t -> Regexp s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
lexaction :: Regexp s t -> Action t -> Lexer s t
lexaction :: Regexp s t -> Action t -> Lexer s t
lexaction re :: Regexp s t
re a :: Action t
a = Regexp s t
re Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall c a a.
String
-> Position -> c -> (Maybe (Either a t), Position, c, Maybe a)
a'
where
a' :: String
-> Position -> c -> (Maybe (Either a t), Position, c, Maybe a)
a' lexeme :: String
lexeme pos :: Position
pos@(Position fname :: String
fname row :: Int
row col :: Int
col) s :: c
s =
let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lexeme
in
Int
col' Int
-> (Maybe (Either a t), Position, c, Maybe a)
-> (Maybe (Either a t), Position, c, Maybe a)
forall a b. a -> b -> b
`seq` case Action t
a String
lexeme Position
pos of
Nothing -> (Maybe (Either a t)
forall a. Maybe a
Nothing, (String -> Int -> Int -> Position
Position String
fname Int
row Int
col'), c
s, Maybe a
forall a. Maybe a
Nothing)
Just t :: t
t -> (Either a t -> Maybe (Either a t)
forall a. a -> Maybe a
Just (t -> Either a t
forall a b. b -> Either a b
Right t
t), (String -> Int -> Int -> Position
Position String
fname Int
row Int
col'), c
s, Maybe a
forall a. Maybe a
Nothing)
lexactionErr :: Regexp s t -> ActionErr t -> Lexer s t
lexactionErr :: Regexp s t -> ActionErr t -> Lexer s t
lexactionErr re :: Regexp s t
re a :: ActionErr t
a = Regexp s t
re Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall c a.
String
-> Position -> c -> (Maybe (Either Error t), Position, c, Maybe a)
a'
where
a' :: String
-> Position -> c -> (Maybe (Either Error t), Position, c, Maybe a)
a' lexeme :: String
lexeme pos :: Position
pos@(Position fname :: String
fname row :: Int
row col :: Int
col) s :: c
s =
let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lexeme
in
Int
col' Int
-> (Maybe (Either Error t), Position, c, Maybe a)
-> (Maybe (Either Error t), Position, c, Maybe a)
forall a b. a -> b -> b
`seq` (Either Error t -> Maybe (Either Error t)
forall a. a -> Maybe a
Just (ActionErr t
a String
lexeme Position
pos), (String -> Int -> Int -> Position
Position String
fname Int
row Int
col'), c
s, Maybe a
forall a. Maybe a
Nothing)
lexmeta :: Regexp s t -> Meta s t -> Lexer s t
lexmeta :: Regexp s t -> Meta s t -> Lexer s t
lexmeta re :: Regexp s t
re a :: Meta s t
a = Regexp s t
re (LexAction s t -> Cont s t -> Lexer s t
forall s t. LexAction s t -> Cont s t -> Lexer s t
Lexer (Meta s t -> LexAction s t
forall s t. Meta s t -> LexAction s t
Action Meta s t
a) Cont s t
forall s t. Cont s t
Done)
(>|<) :: Regexp s t -> Regexp s t -> Regexp s t
re :: Regexp s t
re >|< :: Regexp s t -> Regexp s t -> Regexp s t
>|< re' :: Regexp s t
re' = \l :: Lexer s t
l -> Regexp s t
re Lexer s t
l Lexer s t -> Regexp s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
>||< Regexp s t
re' Lexer s t
l
(>||<) :: Lexer s t -> Lexer s t -> Lexer s t
(Lexer a :: LexAction s t
a c :: Cont s t
c) >||< :: Lexer s t -> Lexer s t -> Lexer s t
>||< (Lexer a' :: LexAction s t
a' c' :: Cont s t
c') = LexAction s t -> Cont s t -> Lexer s t
forall s t. LexAction s t -> Cont s t -> Lexer s t
Lexer (LexAction s t -> LexAction s t -> LexAction s t
forall s t. LexAction s t -> LexAction s t -> LexAction s t
joinActions LexAction s t
a LexAction s t
a') (Cont s t -> Cont s t -> Cont s t
forall s t. Cont s t -> Cont s t -> Cont s t
joinConts Cont s t
c Cont s t
c')
joinConts :: Cont s t -> Cont s t -> Cont s t
joinConts :: Cont s t -> Cont s t -> Cont s t
joinConts Done c' :: Cont s t
c' = Cont s t
c'
joinConts c :: Cont s t
c Done = Cont s t
c
joinConts c :: Cont s t
c c' :: Cont s t
c' = let (bn :: BoundsNum
bn , cls :: [(Char, Lexer s t)]
cls ) = Cont s t -> (BoundsNum, [(Char, Lexer s t)])
forall s t. Cont s t -> (BoundsNum, [(Char, Lexer s t)])
listify Cont s t
c
(bn' :: BoundsNum
bn', cls' :: [(Char, Lexer s t)]
cls') = Cont s t -> (BoundsNum, [(Char, Lexer s t)])
forall s t. Cont s t -> (BoundsNum, [(Char, Lexer s t)])
listify Cont s t
c'
in
BoundsNum -> [(Char, Lexer s t)] -> Cont s t
forall s t. BoundsNum -> [(Char, Lexer s t)] -> Cont s t
aggregate (BoundsNum -> BoundsNum -> BoundsNum
addBoundsNum BoundsNum
bn BoundsNum
bn') ([(Char, Lexer s t)]
cls [(Char, Lexer s t)] -> [(Char, Lexer s t)] -> [(Char, Lexer s t)]
forall a. [a] -> [a] -> [a]
++ [(Char, Lexer s t)]
cls')
where
listify :: Cont s t -> (BoundsNum, [(Char, Lexer s t)])
listify (Dense n :: BoundsNum
n arr :: Array Char (Lexer s t)
arr) = (BoundsNum
n, Array Char (Lexer s t) -> [(Char, Lexer s t)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs Array Char (Lexer s t)
arr)
listify (Sparse n :: BoundsNum
n cls :: [(Char, Lexer s t)]
cls) = (BoundsNum
n, [(Char, Lexer s t)]
cls)
listify _ = String -> (BoundsNum, [(Char, Lexer s t)])
forall a. String -> a
interr "Lexers.listify: Impossible argument!"
joinActions :: LexAction s t -> LexAction s t -> LexAction s t
joinActions :: LexAction s t -> LexAction s t -> LexAction s t
joinActions NoAction a' :: LexAction s t
a' = LexAction s t
a'
joinActions a :: LexAction s t
a NoAction = LexAction s t
a
joinActions _ _ = String -> LexAction s t
forall a. String -> a
interr "Lexers.>||<: Overlapping actions!"
aggregate :: BoundsNum -> ([(Char, Lexer s t)]) -> Cont s t
aggregate :: BoundsNum -> [(Char, Lexer s t)] -> Cont s t
aggregate bn :: BoundsNum
bn@(n :: Int
n, lc :: Char
lc, hc :: Char
hc) cls :: [(Char, Lexer s t)]
cls
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
denseMin = BoundsNum -> Array Char (Lexer s t) -> Cont s t
forall s t. BoundsNum -> Array Char (Lexer s t) -> Cont s t
Dense BoundsNum
bn ((Lexer s t -> Lexer s t -> Lexer s t)
-> Lexer s t
-> (Char, Char)
-> [(Char, Lexer s t)]
-> Array Char (Lexer s t)
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Lexer s t -> Lexer s t -> Lexer s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
(>||<) Lexer s t
forall s t. Lexer s t
noLexer (Char
lc, Char
hc) [(Char, Lexer s t)]
cls)
| Bool
otherwise = BoundsNum -> [(Char, Lexer s t)] -> Cont s t
forall s t. BoundsNum -> [(Char, Lexer s t)] -> Cont s t
Sparse BoundsNum
bn ((Lexer s t -> Lexer s t -> Lexer s t)
-> [(Char, Lexer s t)] -> [(Char, Lexer s t)]
forall a b. Eq a => (b -> b -> b) -> [(a, b)] -> [(a, b)]
accum Lexer s t -> Lexer s t -> Lexer s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
(>||<) [(Char, Lexer s t)]
cls)
where
noLexer :: Lexer s t
noLexer = LexAction s t -> Cont s t -> Lexer s t
forall s t. LexAction s t -> Cont s t -> Lexer s t
Lexer LexAction s t
forall s t. LexAction s t
NoAction Cont s t
forall s t. Cont s t
Done
accum :: Eq a => (b -> b -> b) -> [(a, b)] -> [(a, b)]
accum :: (b -> b -> b) -> [(a, b)] -> [(a, b)]
accum f :: b -> b -> b
f [] = []
accum f :: b -> b -> b
f ((k :: a
k, e :: b
e):kes :: [(a, b)]
kes) =
let (ke :: (a, b)
ke, kes' :: [(a, b)]
kes') = a -> b -> [(a, b)] -> ((a, b), [(a, b)])
forall t. Eq t => t -> b -> [(t, b)] -> ((t, b), [(t, b)])
gather a
k b
e [(a, b)]
kes
in
(a, b)
ke (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: (b -> b -> b) -> [(a, b)] -> [(a, b)]
forall a b. Eq a => (b -> b -> b) -> [(a, b)] -> [(a, b)]
accum b -> b -> b
f [(a, b)]
kes'
where
gather :: t -> b -> [(t, b)] -> ((t, b), [(t, b)])
gather k :: t
k e :: b
e [] = ((t
k, b
e), [])
gather k :: t
k e :: b
e (ke' :: (t, b)
ke'@(k' :: t
k', e' :: b
e'):kes :: [(t, b)]
kes) | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
k' = t -> b -> [(t, b)] -> ((t, b), [(t, b)])
gather t
k (b -> b -> b
f b
e b
e') [(t, b)]
kes
| Bool
otherwise = let
(ke'' :: (t, b)
ke'', kes' :: [(t, b)]
kes') = t -> b -> [(t, b)] -> ((t, b), [(t, b)])
gather t
k b
e [(t, b)]
kes
in
((t, b)
ke'', (t, b)
ke'(t, b) -> [(t, b)] -> [(t, b)]
forall a. a -> [a] -> [a]
:[(t, b)]
kes')
ctrlChars :: [Char]
ctrlChars :: String
ctrlChars = ['\n', '\r', '\f', '\t']
ctrlLexer :: Lexer s t
ctrlLexer :: Lexer s t
ctrlLexer =
Char -> Regexp s t
forall s t. Char -> Regexp s t
char '\n' Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall p c a a.
p -> Position -> c -> (Maybe a, Position, c, Maybe a)
newline
Lexer s t -> Regexp s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
>||< Char -> Regexp s t
forall s t. Char -> Regexp s t
char '\r' Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall p c a a.
p -> Position -> c -> (Maybe a, Position, c, Maybe a)
newline
Lexer s t -> Regexp s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
>||< Char -> Regexp s t
forall s t. Char -> Regexp s t
char '\v' Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall p c a a.
p -> Position -> c -> (Maybe a, Position, c, Maybe a)
newline
Lexer s t -> Regexp s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
>||< Char -> Regexp s t
forall s t. Char -> Regexp s t
char '\f' Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall p c a a.
p -> Position -> c -> (Maybe a, Position, c, Maybe a)
formfeed
Lexer s t -> Regexp s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
>||< Char -> Regexp s t
forall s t. Char -> Regexp s t
char '\t' Regexp s t -> Meta s t -> Lexer s t
forall s t. Regexp s t -> Meta s t -> Lexer s t
`lexmeta` Meta s t
forall p c a a.
p -> Position -> c -> (Maybe a, Position, c, Maybe a)
tab
where
newline :: p -> Position -> c -> (Maybe a, Position, c, Maybe a)
newline _ pos :: Position
pos s :: c
s = (Maybe a
forall a. Maybe a
Nothing, Position -> Position
retPos Position
pos , c
s, Maybe a
forall a. Maybe a
Nothing)
formfeed :: p -> Position -> c -> (Maybe a, Position, c, Maybe a)
formfeed _ pos :: Position
pos s :: c
s = (Maybe a
forall a. Maybe a
Nothing, Position -> Int -> Position
incPos Position
pos 1, c
s, Maybe a
forall a. Maybe a
Nothing)
tab :: p -> Position -> c -> (Maybe a, Position, c, Maybe a)
tab _ pos :: Position
pos s :: c
s = (Maybe a
forall a. Maybe a
Nothing, Position -> Position
tabPos Position
pos , c
s, Maybe a
forall a. Maybe a
Nothing)
star :: Regexp s t -> Regexp s t -> Regexp s t
star :: Regexp s t -> Regexp s t -> Regexp s t
star re1 :: Regexp s t
re1 re2 :: Regexp s t
re2 = \l :: Lexer s t
l -> let self :: Lexer s t
self = Regexp s t
re1 Lexer s t
self Lexer s t -> Regexp s t
forall s t. Lexer s t -> Lexer s t -> Lexer s t
>||< Regexp s t
re2 Lexer s t
l
in
Lexer s t
self
plus :: Regexp s t -> Regexp s t -> Regexp s t
plus :: Regexp s t -> Regexp s t -> Regexp s t
plus re1 :: Regexp s t
re1 re2 :: Regexp s t
re2 = Regexp s t
re1 Regexp s t -> Regexp s t -> Regexp s t
forall s t. Regexp s t -> Regexp s t -> Regexp s t
+> (Regexp s t
re1 Regexp s t -> Regexp s t -> Regexp s t
forall s t. Regexp s t -> Regexp s t -> Regexp s t
`star` Regexp s t
re2)
quest :: Regexp s t -> Regexp s t -> Regexp s t
quest :: Regexp s t -> Regexp s t -> Regexp s t
quest re1 :: Regexp s t
re1 re2 :: Regexp s t
re2 = (Regexp s t
re1 Regexp s t -> Regexp s t -> Regexp s t
forall s t. Regexp s t -> Regexp s t -> Regexp s t
+> Regexp s t
re2) Regexp s t -> Regexp s t -> Regexp s t
forall s t. Regexp s t -> Regexp s t -> Regexp s t
>|< Regexp s t
re2
alt :: [Char] -> Regexp s t
alt :: String -> Regexp s t
alt [] = String -> Regexp s t
forall a. String -> a
interr "Lexers.alt: Empty character set!"
alt cs :: String
cs = \l :: Lexer s t
l -> let bnds :: BoundsNum
bnds = (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs, String -> Char
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum String
cs, String -> Char
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum String
cs)
in
LexAction s t -> Cont s t -> Lexer s t
forall s t. LexAction s t -> Cont s t -> Lexer s t
Lexer LexAction s t
forall s t. LexAction s t
NoAction (BoundsNum -> [(Char, Lexer s t)] -> Cont s t
forall s t. BoundsNum -> [(Char, Lexer s t)] -> Cont s t
aggregate BoundsNum
bnds [(Char
c, Lexer s t
l) | Char
c <- String
cs])
string :: String -> Regexp s t
string :: String -> Regexp s t
string [] = String -> Regexp s t
forall a. String -> a
interr "Lexers.string: Empty character set!"
string cs :: String
cs = ((Regexp s t -> Regexp s t -> Regexp s t)
-> [Regexp s t] -> Regexp s t
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Regexp s t -> Regexp s t -> Regexp s t
forall s t. Regexp s t -> Regexp s t -> Regexp s t
(+>) ([Regexp s t] -> Regexp s t)
-> (String -> [Regexp s t]) -> String -> Regexp s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Regexp s t) -> String -> [Regexp s t]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Regexp s t
forall s t. Char -> Regexp s t
char) String
cs
type LexerState s = (String, Position, s)
execLexer :: Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
execLexer :: Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
execLexer l :: Lexer s t
l state :: LexerState s
state@([], _, _) = ([], LexerState s
state, [])
execLexer l :: Lexer s t
l state :: LexerState s
state =
case Lexer s t
-> LexerState s
-> (Maybe (Either Error t), Lexer s t, LexerState s)
lexOne Lexer s t
l LexerState s
state of
(Nothing , _ , state' :: LexerState s
state') -> Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
forall s t.
Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
execLexer Lexer s t
l LexerState s
state'
(Just res :: Either Error t
res, l' :: Lexer s t
l', state' :: LexerState s
state') -> let (ts :: [t]
ts, final :: LexerState s
final, allErrs :: [Error]
allErrs) = Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
forall s t.
Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
execLexer Lexer s t
l' LexerState s
state'
in case Either Error t
res of
(Left err :: Error
err) -> ([t]
ts , LexerState s
final, Error
errError -> [Error] -> [Error]
forall a. a -> [a] -> [a]
:[Error]
allErrs)
(Right t :: t
t ) -> (t
tt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
ts, LexerState s
final, [Error]
allErrs)
where
lexOne :: Lexer s t
-> LexerState s
-> (Maybe (Either Error t), Lexer s t, LexerState s)
lexOne l0 :: Lexer s t
l0 state :: LexerState s
state = Lexer s t
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
oneLexeme Lexer s t
l0 LexerState s
state DList Char
forall a. DList a
zeroDL (Maybe (Either Error t), Lexer s t, LexerState s)
forall b. (Maybe (Either Error b), Lexer s t, LexerState s)
lexErr
where
lexErr :: (Maybe (Either Error b), Lexer s t, LexerState s)
lexErr = let (cs :: String
cs, pos :: Position
pos@(Position fname :: String
fname row :: Int
row col :: Int
col), s :: s
s) = LexerState s
state
err :: Error
err = ErrorLvl -> Position -> [String] -> Error
makeError ErrorLvl
ErrorErr Position
pos
["Lexical error!",
"The character " String -> DList Char
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show (String -> Char
forall a. [a] -> a
head String
cs)
String -> DList Char
forall a. [a] -> [a] -> [a]
++ " does not fit here; skipping it."]
in
(Either Error b -> Maybe (Either Error b)
forall a. a -> Maybe a
Just (Error -> Either Error b
forall a b. a -> Either a b
Left Error
err), Lexer s t
l, (DList Char
forall a. DList a
tail String
cs, (String -> Int -> Int -> Position
Position String
fname Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)), s
s))
oneLexeme :: Lexer s t
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
oneLexeme (Lexer a :: LexAction s t
a cont :: Cont s t
cont) state :: LexerState s
state@(cs :: String
cs, pos :: Position
pos, s :: s
s) csDL :: DList Char
csDL last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last =
let last' :: (Maybe (Either Error t), Lexer s t, LexerState s)
last' = LexAction s t
-> DList Char
-> LexerState s
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
action LexAction s t
a DList Char
csDL LexerState s
state (Maybe (Either Error t), Lexer s t, LexerState s)
last
in case String
cs of
[] -> (Maybe (Either Error t), Lexer s t, LexerState s)
last'
(c :: Char
c:cs' :: String
cs') -> Cont s t
-> Char
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
oneChar Cont s t
cont Char
c (String
cs', Position
pos, s
s) DList Char
csDL (Maybe (Either Error t), Lexer s t, LexerState s)
last'
oneChar :: Cont s t
-> Char
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
oneChar Done c :: Char
c state :: LexerState s
state csDL :: DList Char
csDL last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last = (Maybe (Either Error t), Lexer s t, LexerState s)
last
oneChar (Dense bn :: BoundsNum
bn arr :: Array Char (Lexer s t)
arr) c :: Char
c state :: LexerState s
state csDL :: DList Char
csDL last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last
| Char
c Char -> BoundsNum -> Bool
`inBounds` BoundsNum
bn = Lexer s t
-> Char
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
cont (Array Char (Lexer s t)
arrArray Char (Lexer s t) -> Char -> Lexer s t
forall i e. Ix i => Array i e -> i -> e
!Char
c) Char
c LexerState s
state DList Char
csDL (Maybe (Either Error t), Lexer s t, LexerState s)
last
| Bool
otherwise = (Maybe (Either Error t), Lexer s t, LexerState s)
last
oneChar (Sparse bn :: BoundsNum
bn cls :: [(Char, Lexer s t)]
cls) c :: Char
c state :: LexerState s
state csDL :: DList Char
csDL last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last
| Char
c Char -> BoundsNum -> Bool
`inBounds` BoundsNum
bn = case Char -> [(Char, Lexer s t)] -> Maybe (Lexer s t)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c [(Char, Lexer s t)]
cls of
Nothing -> (Maybe (Either Error t), Lexer s t, LexerState s)
last
Just l' :: Lexer s t
l' -> Lexer s t
-> Char
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
cont Lexer s t
l' Char
c LexerState s
state DList Char
csDL (Maybe (Either Error t), Lexer s t, LexerState s)
last
| Bool
otherwise = (Maybe (Either Error t), Lexer s t, LexerState s)
last
cont :: Lexer s t
-> Char
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
cont l' :: Lexer s t
l' c :: Char
c state :: LexerState s
state csDL :: DList Char
csDL last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last = Lexer s t
-> LexerState s
-> DList Char
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
oneLexeme Lexer s t
l' LexerState s
state (DList Char
csDL DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
`snocDL` Char
c) (Maybe (Either Error t), Lexer s t, LexerState s)
last
action :: LexAction s t
-> DList Char
-> LexerState s
-> (Maybe (Either Error t), Lexer s t, LexerState s)
-> (Maybe (Either Error t), Lexer s t, LexerState s)
action (Action f :: Meta s t
f) csDL :: DList Char
csDL (cs :: String
cs, pos :: Position
pos, s :: s
s) last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last =
case Meta s t
f (DList Char -> String
forall a. DList a -> [a]
closeDL DList Char
csDL) Position
pos s
s of
(Nothing, pos' :: Position
pos', s' :: s
s', l' :: Maybe (Lexer s t)
l')
| Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
cs -> Lexer s t
-> LexerState s
-> (Maybe (Either Error t), Lexer s t, LexerState s)
lexOne (Lexer s t -> Maybe (Lexer s t) -> Lexer s t
forall a. a -> Maybe a -> a
fromMaybe Lexer s t
l0 Maybe (Lexer s t)
l') (String
cs, Position
pos', s
s')
(res :: Maybe (Either Error t)
res , pos' :: Position
pos', s' :: s
s', l' :: Maybe (Lexer s t)
l') -> (Maybe (Either Error t)
res, (Lexer s t -> Maybe (Lexer s t) -> Lexer s t
forall a. a -> Maybe a -> a
fromMaybe Lexer s t
l0 Maybe (Lexer s t)
l'), (String
cs, Position
pos', s
s'))
action NoAction csDL :: DList Char
csDL state :: LexerState s
state last :: (Maybe (Either Error t), Lexer s t, LexerState s)
last =
(Maybe (Either Error t), Lexer s t, LexerState s)
last