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 = Int
20
type BoundsNum = (Int, Char, Char)
nullBoundsNum :: BoundsNum
nullBoundsNum :: BoundsNum
nullBoundsNum = (Int
0, Char
forall a. Bounded a => a
maxBound, Char
forall a. Bounded a => a
minBound)
addBoundsNum :: BoundsNum -> BoundsNum -> BoundsNum
addBoundsNum :: BoundsNum -> BoundsNum -> BoundsNum
addBoundsNum (Int
n, Char
lc, Char
hc) (Int
n', Char
lc', 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 Char
c (Int
_, Char
lc, 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 Char
c = \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 (Int
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 Regexp s t
re 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' String
lexeme pos :: Position
pos@(Position String
fname Int
row Int
col) 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)
`seq` case Action t
a String
lexeme Position
pos of
Maybe t
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 -> (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 Regexp s t
re 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' String
lexeme pos :: Position
pos@(Position String
fname Int
row Int
col) 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)
`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 Regexp s t
re 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
Regexp s t
re >|< :: Regexp s t -> Regexp s t -> Regexp s t
>|< Regexp s t
re' = \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 LexAction s t
a Cont s t
c) >||< :: Lexer s t -> Lexer s t -> Lexer s t
>||< (Lexer LexAction s t
a' 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 Cont s t
Done Cont s t
c' = Cont s t
c'
joinConts Cont s t
c Cont s t
Done = Cont s t
c
joinConts Cont s t
c Cont s t
c' = let (BoundsNum
bn , [(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
(BoundsNum
bn', [(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 BoundsNum
n 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 BoundsNum
n [(Char, Lexer s t)]
cls) = (BoundsNum
n, [(Char, Lexer s t)]
cls)
listify Cont s t
_ = String -> (BoundsNum, [(Char, Lexer s t)])
forall a. String -> a
interr String
"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 LexAction s t
NoAction LexAction s t
a' = LexAction s t
a'
joinActions LexAction s t
a LexAction s t
NoAction = LexAction s t
a
joinActions LexAction s t
_ LexAction s t
_ = String -> LexAction s t
forall a. String -> a
interr String
"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@(Int
n, Char
lc, Char
hc) [(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 b -> b -> b
f [] = []
accum b -> b -> b
f ((a
k, b
e):[(a, b)]
kes) =
let ((a, b)
ke, [(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 t
k b
e [] = ((t
k, b
e), [])
gather t
k b
e (ke' :: (t, b)
ke'@(t
k', b
e'):[(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
((t, b)
ke'', [(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 = [Char
'\n', Char
'\r', Char
'\f', Char
'\t']
ctrlLexer :: Lexer s t
ctrlLexer :: Lexer s t
ctrlLexer =
Char -> Regexp s t
forall s t. Char -> Regexp s t
char 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 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 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 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 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 p
_ Position
pos 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 p
_ Position
pos c
s = (Maybe a
forall a. Maybe a
Nothing, Position -> Int -> Position
incPos Position
pos Int
1, c
s, Maybe a
forall a. Maybe a
Nothing)
tab :: p -> Position -> c -> (Maybe a, Position, c, Maybe a)
tab p
_ Position
pos 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 Regexp s t
re1 Regexp s t
re2 = \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 Regexp s t
re1 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 Regexp s t
re1 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 String
"Lexers.alt: Empty character set!"
alt String
cs = \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 String
"Lexers.string: Empty character set!"
string 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 Lexer s t
l state :: LexerState s
state@([], Position
_, s
_) = ([], LexerState s
state, [])
execLexer Lexer s t
l 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
(Maybe (Either Error t)
Nothing , Lexer s t
_ , 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 Either Error t
res, Lexer s t
l', LexerState s
state') -> let ([t]
ts, LexerState s
final, [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 Error
err) -> ([t]
ts , LexerState s
final, Error
errError -> [Error] -> [Error]
forall a. a -> [a] -> [a]
:[Error]
allErrs)
(Right 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 Lexer s t
l0 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 (String
cs, pos :: Position
pos@(Position String
fname Int
row Int
col), s
s) = LexerState s
state
err :: Error
err = ErrorLvl -> Position -> [String] -> Error
makeError ErrorLvl
ErrorErr Position
pos
[String
"Lexical error!",
String
"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]
++ String
" 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
+ Int
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 LexAction s t
a Cont s t
cont) state :: LexerState s
state@(String
cs, Position
pos, s
s) DList Char
csDL (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'
(Char
c: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 Cont s t
Done Char
c LexerState s
state DList Char
csDL (Maybe (Either Error t), Lexer s t, LexerState s)
last = (Maybe (Either Error t), Lexer s t, LexerState s)
last
oneChar (Dense BoundsNum
bn Array Char (Lexer s t)
arr) Char
c LexerState s
state DList Char
csDL (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 BoundsNum
bn [(Char, Lexer s t)]
cls) Char
c LexerState s
state DList Char
csDL (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
Maybe (Lexer s t)
Nothing -> (Maybe (Either Error t), Lexer s t, LexerState s)
last
Just 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 Lexer s t
l' Char
c LexerState s
state DList Char
csDL (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 Meta s t
f) DList Char
csDL (String
cs, Position
pos, s
s) (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
(Maybe (Either Error t)
Nothing, Position
pos', s
s', 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')
(Maybe (Either Error t)
res , Position
pos', s
s', 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 LexAction s t
NoAction DList Char
csDL LexerState s
state (Maybe (Either Error t), Lexer s t, LexerState s)
last =
(Maybe (Either Error t), Lexer s t, LexerState s)
last