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 :: forall s t. Regexp s t
epsilon = Lexer s t -> Lexer s t
forall a. a -> a
id
char :: Char -> Regexp s t
char :: forall s t. 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
+> :: forall s t. Regexp s t -> Regexp s t -> Regexp s t
(+>) = (Lexer s t -> Lexer s t)
-> (Lexer s t -> Lexer s t) -> Lexer s t -> Lexer s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
lexaction :: Regexp s t -> Action t -> Lexer s t
lexaction :: forall s t. 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}.
[Char]
-> Position -> c -> (Maybe (Either a t), Position, c, Maybe a)
a'
where
a' :: [Char]
-> Position -> c -> (Maybe (Either a t), Position, c, Maybe a)
a' [Char]
lexeme pos :: Position
pos@(Position [Char]
fname Int
row Int
col) c
s =
let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
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 [Char]
lexeme Position
pos of
Maybe t
Nothing -> (Maybe (Either a t)
forall a. Maybe a
Nothing, ([Char] -> Int -> Int -> Position
Position [Char]
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), ([Char] -> Int -> Int -> Position
Position [Char]
fname Int
row Int
col'), c
s, Maybe a
forall a. Maybe a
Nothing)
lexactionErr :: Regexp s t -> ActionErr t -> Lexer s t
lexactionErr :: forall s t. 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}.
[Char]
-> Position -> c -> (Maybe (Either Error t), Position, c, Maybe a)
a'
where
a' :: [Char]
-> Position -> c -> (Maybe (Either Error t), Position, c, Maybe a)
a' [Char]
lexeme pos :: Position
pos@(Position [Char]
fname Int
row Int
col) c
s =
let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
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 [Char]
lexeme Position
pos), ([Char] -> Int -> Int -> Position
Position [Char]
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 :: forall s t. 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 >|< :: forall s t. 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) >||< :: forall s t. 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 :: forall s t. 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
_ = [Char] -> (BoundsNum, [(Char, Lexer s t)])
forall a. [Char] -> a
interr [Char]
"Lexers.listify: Impossible argument!"
joinActions :: LexAction s t -> LexAction s t -> LexAction s t
joinActions :: forall s t. 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
_ = [Char] -> LexAction s t
forall a. [Char] -> a
interr [Char]
"Lexers.>||<: Overlapping actions!"
aggregate :: BoundsNum -> ([(Char, Lexer s t)]) -> Cont s t
aggregate :: forall s t. 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 :: forall a b. Eq a => (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 :: [Char]
ctrlChars = [Char
'\n', Char
'\r', Char
'\f', Char
'\t']
ctrlLexer :: Lexer s t
ctrlLexer :: forall {s} {t}. 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 :: forall s t. 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 :: forall s t. 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 :: forall s t. 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 :: forall s t. [Char] -> Regexp s t
alt [] = [Char] -> Regexp s t
forall a. [Char] -> a
interr [Char]
"Lexers.alt: Empty character set!"
alt [Char]
cs = \Lexer s t
l -> let bnds :: BoundsNum
bnds = ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
cs, [Char] -> Char
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Char]
cs, [Char] -> Char
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Char]
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 <- [Char]
cs])
string :: String -> Regexp s t
string :: forall s t. [Char] -> Regexp s t
string [] = [Char] -> Regexp s t
forall a. [Char] -> a
interr [Char]
"Lexers.string: Empty character set!"
string [Char]
cs = ((Regexp s t -> Regexp s t -> Regexp s t)
-> [Regexp s t] -> Regexp s t
forall a. (a -> a -> a) -> [a] -> a
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)
-> ([Char] -> [Regexp s t]) -> [Char] -> Regexp s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Regexp s t) -> [Char] -> [Regexp s t]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Regexp s t
forall s t. Char -> Regexp s t
char) [Char]
cs
type LexerState s = (String, Position, s)
execLexer :: Lexer s t -> LexerState s -> ([t], LexerState s, [Error])
execLexer :: forall s t.
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
-> ([Char] -> [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 [Char] -> [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 ([Char]
cs, pos :: Position
pos@(Position [Char]
fname Int
row Int
col), s
s) = LexerState s
state
err :: Error
err = ErrorLvl -> Position -> [[Char]] -> Error
makeError ErrorLvl
ErrorErr Position
pos
[[Char]
"Lexical error!",
[Char]
"The character " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
cs)
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" 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, ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
cs, ([Char] -> Int -> Int -> Position
Position [Char]
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
-> ([Char] -> [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@([Char]
cs, Position
pos, s
s) [Char] -> [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
-> ([Char] -> [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 [Char] -> [Char]
csDL LexerState s
state (Maybe (Either Error t), Lexer s t, LexerState s)
last
in case [Char]
cs of
[] -> (Maybe (Either Error t), Lexer s t, LexerState s)
last'
(Char
c:[Char]
cs') -> Cont s t
-> Char
-> LexerState s
-> ([Char] -> [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 ([Char]
cs', Position
pos, s
s) [Char] -> [Char]
csDL (Maybe (Either Error t), Lexer s t, LexerState s)
last'
oneChar :: Cont s t
-> Char
-> LexerState s
-> ([Char] -> [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 [Char] -> [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 [Char] -> [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
-> ([Char] -> [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 [Char] -> [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 [Char] -> [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
-> ([Char] -> [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 [Char] -> [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
-> ([Char] -> [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 [Char] -> [Char]
csDL (Maybe (Either Error t), Lexer s t, LexerState s)
last = Lexer s t
-> LexerState s
-> ([Char] -> [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 ([Char] -> [Char]
csDL ([Char] -> [Char]) -> Char -> [Char] -> [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
-> ([Char] -> [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) [Char] -> [Char]
csDL ([Char]
cs, Position
pos, s
s) (Maybe (Either Error t), Lexer s t, LexerState s)
last =
case Meta s t
f (([Char] -> [Char]) -> [Char]
forall a. DList a -> [a]
closeDL [Char] -> [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) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
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') ([Char]
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'), ([Char]
cs, Position
pos', s
s'))
action LexAction s t
NoAction [Char] -> [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