{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Sugar.Lexer
  ( LexerState(..)
  , LexemeStep
  , SourceLocation(..)
  , Lexeme(..)
  , sugarLexerState
  ) where

import Data.Char
import Safe.Exact (splitAtExactMay)

import Sugar.Types

data LexerState = LexerState
  { LexerState -> [LexemeStep]
psSteps :: [LexemeStep]
  , LexerState -> SourceLocation
psLocation :: SourceLocation
  } deriving (Int -> LexerState -> ShowS
[LexerState] -> ShowS
LexerState -> String
(Int -> LexerState -> ShowS)
-> (LexerState -> String)
-> ([LexerState] -> ShowS)
-> Show LexerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LexerState] -> ShowS
$cshowList :: [LexerState] -> ShowS
show :: LexerState -> String
$cshow :: LexerState -> String
showsPrec :: Int -> LexerState -> ShowS
$cshowsPrec :: Int -> LexerState -> ShowS
Show, LexerState -> LexerState -> Bool
(LexerState -> LexerState -> Bool)
-> (LexerState -> LexerState -> Bool) -> Eq LexerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LexerState -> LexerState -> Bool
$c/= :: LexerState -> LexerState -> Bool
== :: LexerState -> LexerState -> Bool
$c== :: LexerState -> LexerState -> Bool
Eq)

type LexemeStep = (SourceLocation, Lexeme)

data SourceLocation = SourceLocation
  { SourceLocation -> Int
slLine :: Int
  , SourceLocation -> Int
slColumn :: Int
  } deriving (Int -> SourceLocation -> ShowS
[SourceLocation] -> ShowS
SourceLocation -> String
(Int -> SourceLocation -> ShowS)
-> (SourceLocation -> String)
-> ([SourceLocation] -> ShowS)
-> Show SourceLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceLocation] -> ShowS
$cshowList :: [SourceLocation] -> ShowS
show :: SourceLocation -> String
$cshow :: SourceLocation -> String
showsPrec :: Int -> SourceLocation -> ShowS
$cshowsPrec :: Int -> SourceLocation -> ShowS
Show, SourceLocation -> SourceLocation -> Bool
(SourceLocation -> SourceLocation -> Bool)
-> (SourceLocation -> SourceLocation -> Bool) -> Eq SourceLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceLocation -> SourceLocation -> Bool
$c/= :: SourceLocation -> SourceLocation -> Bool
== :: SourceLocation -> SourceLocation -> Bool
$c== :: SourceLocation -> SourceLocation -> Bool
Eq)

data Lexeme
  = Lexeme'Start
  | Lexeme'OpenCurl
  | Lexeme'CloseCurl
  | Lexeme'OpenParen
  | Lexeme'CloseParen
  | Lexeme'OpenSquare
  | Lexeme'CloseSquare
  | Lexeme'OpenAngle
  | Lexeme'CloseAngle
  | Lexeme'StringStart
  | Lexeme'String String
  | Lexeme'QuoteStart
  | Lexeme'QuotedString String
  | Lexeme'QuoteEnd
  | Lexeme'SingleLineComment
  | Lexeme'MultiLineCommentStart
  | Lexeme'MultiLineCommentEnd
  deriving (Int -> Lexeme -> ShowS
[Lexeme] -> ShowS
Lexeme -> String
(Int -> Lexeme -> ShowS)
-> (Lexeme -> String) -> ([Lexeme] -> ShowS) -> Show Lexeme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lexeme] -> ShowS
$cshowList :: [Lexeme] -> ShowS
show :: Lexeme -> String
$cshow :: Lexeme -> String
showsPrec :: Int -> Lexeme -> ShowS
$cshowsPrec :: Int -> Lexeme -> ShowS
Show, Lexeme -> Lexeme -> Bool
(Lexeme -> Lexeme -> Bool)
-> (Lexeme -> Lexeme -> Bool) -> Eq Lexeme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lexeme -> Lexeme -> Bool
$c/= :: Lexeme -> Lexeme -> Bool
== :: Lexeme -> Lexeme -> Bool
$c== :: Lexeme -> Lexeme -> Bool
Eq)

sugarLexerState :: String -> LexerState
sugarLexerState :: String -> LexerState
sugarLexerState String
s =
  let ls :: LexerState
ls = (String, LexerState) -> LexerState
go (String -> LexerState -> (String, LexerState)
stepReadSugarString String
s LexerState
initLexerState)
  in LexerState
ls { psSteps :: [LexemeStep]
psSteps = [LexemeStep] -> [LexemeStep]
forall a. [a] -> [a]
reverse (LexerState -> [LexemeStep]
psSteps LexerState
ls) }
  where
    go :: (String, LexerState) -> LexerState
go (String
s',LexerState
ps) = case String
s' of
      [] -> LexerState
ps
      String
_ -> (String, LexerState) -> LexerState
go (String -> LexerState -> (String, LexerState)
stepReadSugarString String
s' LexerState
ps)
    initLexerState :: LexerState
    initLexerState :: LexerState
initLexerState = [LexemeStep] -> SourceLocation -> LexerState
LexerState [] (Int -> Int -> SourceLocation
SourceLocation Int
1 Int
1)

incrColLoc :: SourceLocation -> SourceLocation
incrColLoc :: SourceLocation -> SourceLocation
incrColLoc SourceLocation
sl = SourceLocation
sl { slColumn :: Int
slColumn = SourceLocation -> Int
slColumn SourceLocation
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

stepColLoc :: Int -> SourceLocation -> SourceLocation
stepColLoc :: Int -> SourceLocation -> SourceLocation
stepColLoc Int
n SourceLocation
sl = SourceLocation
sl { slColumn :: Int
slColumn = SourceLocation -> Int
slColumn SourceLocation
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }

nextLineLoc :: SourceLocation -> SourceLocation
nextLineLoc :: SourceLocation -> SourceLocation
nextLineLoc SourceLocation
sl = SourceLocation
sl { slLine :: Int
slLine = SourceLocation -> Int
slLine SourceLocation
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, slColumn :: Int
slColumn = Int
1 }

incrColState :: LexerState -> LexerState
incrColState :: LexerState -> LexerState
incrColState LexerState
ps = LexerState
ps { psLocation :: SourceLocation
psLocation = SourceLocation -> SourceLocation
incrColLoc (SourceLocation -> SourceLocation)
-> SourceLocation -> SourceLocation
forall a b. (a -> b) -> a -> b
$ LexerState -> SourceLocation
psLocation LexerState
ps }

stepColState :: Int -> LexerState -> LexerState
stepColState :: Int -> LexerState -> LexerState
stepColState Int
n LexerState
ps = LexerState
ps { psLocation :: SourceLocation
psLocation = Int -> SourceLocation -> SourceLocation
stepColLoc Int
n (SourceLocation -> SourceLocation)
-> SourceLocation -> SourceLocation
forall a b. (a -> b) -> a -> b
$ LexerState -> SourceLocation
psLocation LexerState
ps }

nextLineState :: LexerState -> LexerState
nextLineState :: LexerState -> LexerState
nextLineState LexerState
ps = LexerState
ps { psLocation :: SourceLocation
psLocation = SourceLocation -> SourceLocation
nextLineLoc (SourceLocation -> SourceLocation)
-> SourceLocation -> SourceLocation
forall a b. (a -> b) -> a -> b
$ LexerState -> SourceLocation
psLocation LexerState
ps }

stepLoc :: String -> SourceLocation -> SourceLocation
stepLoc :: String -> SourceLocation -> SourceLocation
stepLoc [] SourceLocation
loc = SourceLocation
loc
stepLoc (Char
x:String
xs) SourceLocation
loc
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = String -> SourceLocation -> SourceLocation
stepLoc String
xs (SourceLocation -> SourceLocation
nextLineLoc SourceLocation
loc)
  | Bool
otherwise = String -> SourceLocation -> SourceLocation
stepLoc String
xs (SourceLocation -> SourceLocation
incrColLoc SourceLocation
loc) -- assuming non-zero width characters

stepLocState :: String -> LexerState -> LexerState
stepLocState :: String -> LexerState -> LexerState
stepLocState String
s LexerState
ps = LexerState
ps { psLocation :: SourceLocation
psLocation = String -> SourceLocation -> SourceLocation
stepLoc String
s (SourceLocation -> SourceLocation)
-> SourceLocation -> SourceLocation
forall a b. (a -> b) -> a -> b
$ LexerState -> SourceLocation
psLocation LexerState
ps }

lastLexeme :: LexerState -> Maybe Lexeme
lastLexeme :: LexerState -> Maybe Lexeme
lastLexeme LexerState
ps = case LexerState -> [LexemeStep]
psSteps LexerState
ps of
  ((SourceLocation
_,Lexeme
t):[LexemeStep]
_) -> Lexeme -> Maybe Lexeme
forall a. a -> Maybe a
Just Lexeme
t
  [] -> Maybe Lexeme
forall a. Maybe a
Nothing

stepReadSugarString :: String -> LexerState -> (String, LexerState)
stepReadSugarString :: String -> LexerState -> (String, LexerState)
stepReadSugarString String
s LexerState
ps = case LexerState -> Maybe Lexeme
lastLexeme LexerState
ps of
  Maybe Lexeme
Nothing -> String -> LexerState -> Lexeme -> (String, LexerState)
stepReadSugarString' String
s LexerState
ps Lexeme
Lexeme'Start -- Benign hack to start parsing
  Just Lexeme
t -> String -> LexerState -> Lexeme -> (String, LexerState)
stepReadSugarString' String
s LexerState
ps Lexeme
t

stepReadSugarString' :: String -> LexerState -> Lexeme -> (String, LexerState)
stepReadSugarString' :: String -> LexerState -> Lexeme -> (String, LexerState)
stepReadSugarString' [] LexerState
ps Lexeme
_ = ([], LexerState
ps)
stepReadSugarString' String
s LexerState
ps Lexeme
t = case Lexeme
t of
  Lexeme
Lexeme'StringStart -> String -> LexerState -> (String, LexerState)
stepReadString String
s LexerState
ps
  Lexeme
Lexeme'QuoteStart -> String -> LexerState -> (String, LexerState)
stepQuotedStart String
s LexerState
ps
  Lexeme'QuotedString String
_ -> String -> LexerState -> (String, LexerState)
stepQuoteString String
s LexerState
ps
  Lexeme
Lexeme'SingleLineComment -> String -> LexerState -> (String, LexerState)
stepSingleLineComment String
s LexerState
ps
  Lexeme
Lexeme'MultiLineCommentStart -> String -> LexerState -> (String, LexerState)
stepMultiLineComment String
s LexerState
ps
  Lexeme
_ -> String -> LexerState -> (String, LexerState)
normalStepReadSugarString String
s LexerState
ps

normalStepReadSugarString :: String -> LexerState -> (String, LexerState)
normalStepReadSugarString :: String -> LexerState -> (String, LexerState)
normalStepReadSugarString [] LexerState
ps = ([], LexerState
ps)
normalStepReadSugarString s :: String
s@(Char
c:String
cs) LexerState
ps
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = (String
cs, LexerState -> LexerState
nextLineState LexerState
ps)
  | Char -> Bool
isSpace Char
c = (String
cs, LexerState -> LexerState
incrColState LexerState
ps)
  | Bool
otherwise = case Char
c of
    Char
'{' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'OpenCurl)
    Char
'}' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'CloseCurl)
    Char
'(' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'OpenParen)
    Char
')' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'CloseParen)
    Char
'[' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'OpenSquare)
    Char
']' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'CloseSquare)
    Char
'<' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'OpenAngle)
    Char
'>' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'CloseAngle)
    Char
'"' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'QuoteStart)
    Char
';' -> (String
cs, Lexeme -> LexerState
step Lexeme
Lexeme'SingleLineComment)
    Char
_ -> case Int -> String -> Maybe (String, String)
forall a. Int -> [a] -> Maybe ([a], [a])
splitAtExactMay Int
2 String
s of
      Just (String
"#|", String
s') ->
        (String
s', Int -> LexerState -> LexerState
stepColState Int
2 (LexerState -> LexerState) -> LexerState -> LexerState
forall a b. (a -> b) -> a -> b
$ LexerState
ps{psSteps :: [LexemeStep]
psSteps = (LexerState -> SourceLocation
psLocation LexerState
ps, Lexeme
Lexeme'MultiLineCommentStart) LexemeStep -> [LexemeStep] -> [LexemeStep]
forall a. a -> [a] -> [a]
: LexerState -> [LexemeStep]
psSteps LexerState
ps})
      Maybe (String, String)
_ -> (String
s, LexerState
ps { psSteps :: [LexemeStep]
psSteps = (LexerState -> SourceLocation
psLocation LexerState
ps, Lexeme
Lexeme'StringStart) LexemeStep -> [LexemeStep] -> [LexemeStep]
forall a. a -> [a] -> [a]
: LexerState -> [LexemeStep]
psSteps LexerState
ps })
    where
      step :: Lexeme -> LexerState
step Lexeme
t = (LexerState -> LexerState
incrColState LexerState
ps) { psSteps :: [LexemeStep]
psSteps = (LexerState -> SourceLocation
psLocation LexerState
ps, Lexeme
t) LexemeStep -> [LexemeStep] -> [LexemeStep]
forall a. a -> [a] -> [a]
: LexerState -> [LexemeStep]
psSteps LexerState
ps }

prependStep :: LexemeStep -> LexerState -> LexerState
prependStep :: LexemeStep -> LexerState -> LexerState
prependStep LexemeStep
s LexerState
ps = LexerState
ps { psSteps :: [LexemeStep]
psSteps = LexemeStep
s LexemeStep -> [LexemeStep] -> [LexemeStep]
forall a. a -> [a] -> [a]
: LexerState -> [LexemeStep]
psSteps LexerState
ps }

stepReadString :: String -> LexerState -> (String, LexerState)
stepReadString :: String -> LexerState -> (String, LexerState)
stepReadString String
s LexerState
ps = (String
s', LexerState
ps')
  where
    ps' :: LexerState
ps' = Int -> LexerState -> LexerState
stepColState (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) (LexerState -> LexerState) -> LexerState -> LexerState
forall a b. (a -> b) -> a -> b
$ LexemeStep -> LexerState -> LexerState
prependStep LexemeStep
step LexerState
ps
    step :: LexemeStep
step = (LexerState -> SourceLocation
psLocation LexerState
ps, String -> Lexeme
Lexeme'String String
str)
    (String
str, String
s') = (Char -> Maybe Char -> Bool) -> String -> (String, String)
forall a. (a -> Maybe a -> Bool) -> [a] -> ([a], [a])
span2
      (\Char
c Maybe Char
c' -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isReservedChar Char
c Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
&& Maybe Char
c' Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'|'))
      String
s

isReservedChar :: Char -> Bool
isReservedChar :: Char -> Bool
isReservedChar = (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
reservedChars

span2 :: (a -> Maybe a -> Bool) -> [a] -> ([a],[a])
span2 :: (a -> Maybe a -> Bool) -> [a] -> ([a], [a])
span2 a -> Maybe a -> Bool
_ [] = ([],[])
span2 a -> Maybe a -> Bool
f (a
x:[]) = if a -> Maybe a -> Bool
f a
x Maybe a
forall a. Maybe a
Nothing then ([a
x],[]) else ([],[a
x])
span2 a -> Maybe a -> Bool
f xs :: [a]
xs@(a
x:a
y:[a]
z)
  | a -> Maybe a -> Bool
f a
x (a -> Maybe a
forall a. a -> Maybe a
Just a
y) = let ([a]
ys,[a]
zs) = (a -> Maybe a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Maybe a -> Bool) -> [a] -> ([a], [a])
span2 a -> Maybe a -> Bool
f (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
z) in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
  | Bool
otherwise = ([], [a]
xs)

stepSingleLineComment :: String -> LexerState -> (String, LexerState)
stepSingleLineComment :: String -> LexerState -> (String, LexerState)
stepSingleLineComment String
s LexerState
ps = (String
s', LexerState
ps')
  where
    ps' :: LexerState
ps' = Int -> LexerState -> LexerState
stepColState (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) (LexerState -> LexerState) -> LexerState -> LexerState
forall a b. (a -> b) -> a -> b
$ LexemeStep -> LexerState -> LexerState
prependStep LexemeStep
step LexerState
ps
    step :: LexemeStep
step = (LexerState -> SourceLocation
psLocation LexerState
ps, String -> Lexeme
Lexeme'String String
str)
    (String
str, String
s') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s

stepMultiLineComment :: String -> LexerState -> (String, LexerState)
stepMultiLineComment :: String -> LexerState -> (String, LexerState)
stepMultiLineComment String
s LexerState
ps =  case (Char -> Char -> Bool) -> String -> Maybe (String, String)
forall a. (a -> a -> Bool) -> [a] -> Maybe ([a], [a])
span2ExactSkip (\Char
c Char
c' -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
&& Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') String
s of
  Maybe (String, String)
Nothing -> (String
"", String -> LexerState -> LexerState
stepLocState String
s LexerState
ps) -- failed to consume end of comment marker
  Just (String
str, String
s') -> let
    step :: LexemeStep
step = (LexerState -> SourceLocation
psLocation LexerState
ps, Lexeme
Lexeme'MultiLineCommentEnd)
    ps' :: LexerState
ps' = String -> LexerState -> LexerState
stepLocState (String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|#") (LexerState -> LexerState) -> LexerState -> LexerState
forall a b. (a -> b) -> a -> b
$ LexemeStep -> LexerState -> LexerState
prependStep LexemeStep
step LexerState
ps
    in (String
s', LexerState
ps')

span2ExactSkip :: (a -> a -> Bool) -> [a] -> Maybe ([a], [a])
span2ExactSkip :: (a -> a -> Bool) -> [a] -> Maybe ([a], [a])
span2ExactSkip a -> a -> Bool
_ [] = Maybe ([a], [a])
forall a. Maybe a
Nothing
span2ExactSkip a -> a -> Bool
_ (a
_:[]) = Maybe ([a], [a])
forall a. Maybe a
Nothing
span2ExactSkip a -> a -> Bool
f (a
x:a
y:[a]
z)
  | a -> a -> Bool
f a
x a
y = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just ([], [a]
z)
  | Bool
otherwise = (([a], [a]) -> ([a], [a])) -> Maybe ([a], [a]) -> Maybe ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([a]
a,[a]
b) -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a, [a]
b)) ((a -> a -> Bool) -> [a] -> Maybe ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> Maybe ([a], [a])
span2ExactSkip a -> a -> Bool
f (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
z))

stepQuotedStart :: String -> LexerState -> (String, LexerState)
stepQuotedStart :: String -> LexerState -> (String, LexerState)
stepQuotedStart String
s LexerState
ps = (String
s', LexerState
ps')
  where
    ps' :: LexerState
ps' = Int -> LexerState -> LexerState
stepColState (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) (LexerState -> LexerState) -> LexerState -> LexerState
forall a b. (a -> b) -> a -> b
$ LexemeStep -> LexerState -> LexerState
prependStep LexemeStep
step LexerState
ps
    step :: LexemeStep
step = (SourceLocation
loc, String -> Lexeme
Lexeme'QuotedString String
str)
    (SourceLocation
loc, String
str, String
s') = SourceLocation -> String -> (SourceLocation, String, String)
spanWithEscape (LexerState -> SourceLocation
psLocation LexerState
ps) String
s

spanWithEscape :: SourceLocation -> String -> (SourceLocation, String, String)
spanWithEscape :: SourceLocation -> String -> (SourceLocation, String, String)
spanWithEscape SourceLocation
loc [] = (SourceLocation
loc, [],[])
spanWithEscape SourceLocation
loc (Char
x:[]) = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then (SourceLocation -> SourceLocation
incrColLoc SourceLocation
loc, [],[Char
x]) else (SourceLocation
loc, [Char
x],[])
spanWithEscape SourceLocation
loc xs :: String
xs@(Char
x:Char
y:String
z) = case Char
x of
  Char
'"' -> (SourceLocation -> SourceLocation
incrColLoc SourceLocation
loc, [],String
xs)
  Char
'\\' -> case SourceLocation -> String -> (SourceLocation, String, String)
spanWithEscape SourceLocation
loc String
z of
    (SourceLocation
loc', String
ys,String
zs) -> (SourceLocation -> SourceLocation
incrColLoc SourceLocation
loc', Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:String
ys, String
zs)
  Char
'\n' -> let (SourceLocation
loc', String
ys,String
zs) = SourceLocation -> String -> (SourceLocation, String, String)
spanWithEscape SourceLocation
loc (Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:String
z) in (SourceLocation -> SourceLocation
nextLineLoc SourceLocation
loc', Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
ys, String
zs)
  Char
_ -> let (SourceLocation
loc', String
ys,String
zs) = SourceLocation -> String -> (SourceLocation, String, String)
spanWithEscape SourceLocation
loc (Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:String
z) in (SourceLocation -> SourceLocation
incrColLoc SourceLocation
loc', Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
ys, String
zs)

stepQuoteString :: String -> LexerState -> (String, LexerState)
stepQuoteString :: String -> LexerState -> (String, LexerState)
stepQuoteString (Char
'"':String
xs) LexerState
ps = (String
xs, LexerState -> LexerState
incrColState (LexerState -> LexerState) -> LexerState -> LexerState
forall a b. (a -> b) -> a -> b
$ LexemeStep -> LexerState -> LexerState
prependStep (LexerState -> SourceLocation
psLocation LexerState
ps, Lexeme
Lexeme'QuoteEnd) LexerState
ps)
stepQuoteString String
xs LexerState
ps = String -> LexerState -> (String, LexerState)
normalStepReadSugarString String
xs LexerState
ps -- Something went wrong, but keep parsing.