{-# OPTIONS_HADDOCK hide #-}
module Language.Haskell.Exts.InternalLexer (Token(..), showToken, lexer, topLexer) where
import Language.Haskell.Exts.ParseMonad
import Language.Haskell.Exts.SrcLoc hiding (loc)
import Language.Haskell.Exts.Comments
import Language.Haskell.Exts.Extension
import Language.Haskell.Exts.ExtScheme
import Prelude hiding (id, exponent)
import Data.Char
import Data.Ratio
import Data.List (intercalate, isPrefixOf)
import Control.Monad (when)
data Token
= VarId String
| LabelVarId String
| QVarId (String,String)
| IDupVarId (String)
| ILinVarId (String)
| ConId String
| QConId (String,String)
| DVarId [String]
| VarSym String
| ConSym String
| QVarSym (String,String)
| QConSym (String,String)
| IntTok (Integer, String)
| FloatTok (Rational, String)
| Character (Char, String)
| StringTok (String, String)
| IntTokHash (Integer, String)
| WordTokHash (Integer, String)
| FloatTokHash (Rational, String)
| DoubleTokHash (Rational, String)
| CharacterHash (Char, String)
| StringHash (String, String)
| LeftParen
| RightParen
| LeftHashParen
| RightHashParen
| SemiColon
| LeftCurly
| RightCurly
| VRightCurly
| LeftSquare
| RightSquare
| ParArrayLeftSquare
| ParArrayRightSquare
| Comma
| Underscore
| BackQuote
| Dot
| DotDot
| Colon
| QuoteColon
| DoubleColon
| Equals
| Backslash
| Bar
| LeftArrow
| RightArrow
| At
| TApp
| Tilde
| DoubleArrow
| Minus
| Exclamation
| Star
| LeftArrowTail
| RightArrowTail
| LeftDblArrowTail
| RightDblArrowTail
| OpenArrowBracket
| CloseArrowBracket
| THExpQuote
| THTExpQuote
| THPatQuote
| THDecQuote
| THTypQuote
| THCloseQuote
| THTCloseQuote
| THIdEscape (String)
| THParenEscape
| THTIdEscape String
| THTParenEscape
| THVarQuote
| THTyQuote
| THQuasiQuote (String,String)
| RPGuardOpen
| RPGuardClose
| RPCAt
| XCodeTagOpen
| XCodeTagClose
| XStdTagOpen
| XStdTagClose
| XCloseTagOpen
| XEmptyTagClose
| XChildTagOpen
| XPCDATA String
| XRPatOpen
| XRPatClose
| PragmaEnd
| RULES
| INLINE Bool
| INLINE_CONLIKE
| SPECIALISE
| SPECIALISE_INLINE Bool
| SOURCE
| DEPRECATED
| WARNING
| SCC
| GENERATED
| CORE
| UNPACK
| NOUNPACK
| OPTIONS (Maybe String,String)
| LANGUAGE
| ANN
| MINIMAL
| NO_OVERLAP
| OVERLAP
| OVERLAPPING
| OVERLAPPABLE
| OVERLAPS
| INCOHERENT
| COMPLETE
| KW_As
| KW_By
| KW_Case
| KW_Class
| KW_Data
| KW_Default
| KW_Deriving
| KW_Do
| KW_MDo
| KW_Else
| KW_Family
| KW_Forall
| KW_Group
| KW_Hiding
| KW_If
| KW_Import
| KW_In
| KW_Infix
| KW_InfixL
| KW_InfixR
| KW_Instance
| KW_Let
| KW_Module
| KW_NewType
| KW_Of
| KW_Proc
| KW_Rec
| KW_Role
| KW_Then
| KW_Type
| KW_Using
| KW_Where
| KW_Qualified
| KW_Pattern
| KW_Stock
| KW_Anyclass
| KW_Via
| KW_Foreign
| KW_Export
| KW_Safe
| KW_Unsafe
| KW_Threadsafe
| KW_Interruptible
| KW_StdCall
| KW_CCall
| KW_CPlusPlus
| KW_DotNet
| KW_Jvm
| KW_Js
| KW_JavaScript
| KW_CApi
| EOF
deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq,Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)
reserved_ops :: [(String,(Token, Maybe ExtScheme))]
reserved_ops :: [(String, (Token, Maybe ExtScheme))]
reserved_ops = [
( String
"..", (Token
DotDot, forall a. Maybe a
Nothing) ),
( String
":", (Token
Colon, forall a. Maybe a
Nothing) ),
( String
"::", (Token
DoubleColon, forall a. Maybe a
Nothing) ),
( String
"=", (Token
Equals, forall a. Maybe a
Nothing) ),
( String
"\\", (Token
Backslash, forall a. Maybe a
Nothing) ),
( String
"|", (Token
Bar, forall a. Maybe a
Nothing) ),
( String
"<-", (Token
LeftArrow, forall a. Maybe a
Nothing) ),
( String
"->", (Token
RightArrow, forall a. Maybe a
Nothing) ),
( String
"@", (Token
At, forall a. Maybe a
Nothing) ),
( String
"@:", (Token
RPCAt, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
RegularPatterns])) ),
( String
"~", (Token
Tilde, forall a. Maybe a
Nothing) ),
( String
"=>", (Token
DoubleArrow, forall a. Maybe a
Nothing) ),
( String
"*", (Token
Star, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
KindSignatures])) ),
( String
"[:", (Token
ParArrayLeftSquare, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ParallelArrays])) ),
( String
":]", (Token
ParArrayRightSquare, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ParallelArrays])) ),
( String
"-<", (Token
LeftArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
Arrows])) ),
( String
">-", (Token
RightArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
Arrows])) ),
( String
"-<<", (Token
LeftDblArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
Arrows])) ),
( String
">>-", (Token
RightDblArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
Arrows])) ),
( String
"\x2190", (Token
LeftArrow, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
UnicodeSyntax])) ),
( String
"\x2192", (Token
RightArrow, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
UnicodeSyntax])) ),
( String
"\x21d2", (Token
DoubleArrow, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
UnicodeSyntax])) ),
( String
"\x2237", (Token
DoubleColon, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
UnicodeSyntax])) ),
( String
"\x2919", (Token
LeftArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
All [KnownExtension
UnicodeSyntax, KnownExtension
Arrows])) ),
( String
"\x291a", (Token
RightArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
All [KnownExtension
UnicodeSyntax, KnownExtension
Arrows])) ),
( String
"\x291b", (Token
LeftDblArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
All [KnownExtension
UnicodeSyntax, KnownExtension
Arrows])) ),
( String
"\x291c", (Token
RightDblArrowTail, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
All [KnownExtension
UnicodeSyntax, KnownExtension
Arrows])) ),
( String
"\x2605", (Token
Star, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
All [KnownExtension
UnicodeSyntax, KnownExtension
KindSignatures])) ),
( String
"\x2200", (Token
KW_Forall, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
All [KnownExtension
UnicodeSyntax, KnownExtension
ExplicitForAll])) )
]
special_varops :: [(String,(Token, Maybe ExtScheme))]
special_varops :: [(String, (Token, Maybe ExtScheme))]
special_varops = [
( String
".", (Token
Dot, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ExplicitForAll, KnownExtension
ExistentialQuantification])) ),
( String
"-", (Token
Minus, forall a. Maybe a
Nothing) ),
( String
"!", (Token
Exclamation, forall a. Maybe a
Nothing) )
]
reserved_ids :: [(String,(Token, Maybe ExtScheme))]
reserved_ids :: [(String, (Token, Maybe ExtScheme))]
reserved_ids = [
( String
"_", (Token
Underscore, forall a. Maybe a
Nothing) ),
( String
"by", (Token
KW_By, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
TransformListComp])) ),
( String
"case", (Token
KW_Case, forall a. Maybe a
Nothing) ),
( String
"class", (Token
KW_Class, forall a. Maybe a
Nothing) ),
( String
"data", (Token
KW_Data, forall a. Maybe a
Nothing) ),
( String
"default", (Token
KW_Default, forall a. Maybe a
Nothing) ),
( String
"deriving", (Token
KW_Deriving, forall a. Maybe a
Nothing) ),
( String
"do", (Token
KW_Do, forall a. Maybe a
Nothing) ),
( String
"else", (Token
KW_Else, forall a. Maybe a
Nothing) ),
( String
"family", (Token
KW_Family, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
TypeFamilies])) ),
( String
"forall", (Token
KW_Forall, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ExplicitForAll, KnownExtension
ExistentialQuantification])) ),
( String
"group", (Token
KW_Group, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
TransformListComp])) ),
( String
"if", (Token
KW_If, forall a. Maybe a
Nothing) ),
( String
"import", (Token
KW_Import, forall a. Maybe a
Nothing) ),
( String
"in", (Token
KW_In, forall a. Maybe a
Nothing) ),
( String
"infix", (Token
KW_Infix, forall a. Maybe a
Nothing) ),
( String
"infixl", (Token
KW_InfixL, forall a. Maybe a
Nothing) ),
( String
"infixr", (Token
KW_InfixR, forall a. Maybe a
Nothing) ),
( String
"instance", (Token
KW_Instance, forall a. Maybe a
Nothing) ),
( String
"let", (Token
KW_Let, forall a. Maybe a
Nothing) ),
( String
"mdo", (Token
KW_MDo, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
RecursiveDo])) ),
( String
"module", (Token
KW_Module, forall a. Maybe a
Nothing) ),
( String
"newtype", (Token
KW_NewType, forall a. Maybe a
Nothing) ),
( String
"of", (Token
KW_Of, forall a. Maybe a
Nothing) ),
( String
"proc", (Token
KW_Proc, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
Arrows])) ),
( String
"rec", (Token
KW_Rec, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
Arrows, KnownExtension
RecursiveDo, KnownExtension
DoRec])) ),
( String
"then", (Token
KW_Then, forall a. Maybe a
Nothing) ),
( String
"type", (Token
KW_Type, forall a. Maybe a
Nothing) ),
( String
"using", (Token
KW_Using, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
TransformListComp])) ),
( String
"where", (Token
KW_Where, forall a. Maybe a
Nothing) ),
( String
"role", (Token
KW_Role, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
RoleAnnotations]))),
( String
"pattern", (Token
KW_Pattern, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
PatternSynonyms]))),
( String
"stock", (Token
KW_Stock, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
DerivingStrategies]))),
( String
"anyclass", (Token
KW_Anyclass, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
DerivingStrategies]))),
( String
"via", (Token
KW_Via, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
DerivingVia]))),
( String
"foreign", (Token
KW_Foreign, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) )
]
special_varids :: [(String,(Token, Maybe ExtScheme))]
special_varids :: [(String, (Token, Maybe ExtScheme))]
special_varids = [
( String
"as", (Token
KW_As, forall a. Maybe a
Nothing) ),
( String
"qualified", (Token
KW_Qualified, forall a. Maybe a
Nothing) ),
( String
"hiding", (Token
KW_Hiding, forall a. Maybe a
Nothing) ),
( String
"export", (Token
KW_Export, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"safe", (Token
KW_Safe, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface, KnownExtension
SafeImports, KnownExtension
Safe, KnownExtension
Trustworthy])) ),
( String
"unsafe", (Token
KW_Unsafe, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"threadsafe", (Token
KW_Threadsafe, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"interruptible", (Token
KW_Interruptible, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
InterruptibleFFI])) ),
( String
"stdcall", (Token
KW_StdCall, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"ccall", (Token
KW_CCall, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"cplusplus", (Token
KW_CPlusPlus, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"dotnet", (Token
KW_DotNet, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"jvm", (Token
KW_Jvm, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"js", (Token
KW_Js, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"javascript", (Token
KW_JavaScript, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
ForeignFunctionInterface])) ),
( String
"capi", (Token
KW_CApi, forall a. a -> Maybe a
Just ([KnownExtension] -> ExtScheme
Any [KnownExtension
CApiFFI])) )
]
pragmas :: [(String,Token)]
pragmas :: [(String, Token)]
pragmas = [
( String
"rules", Token
RULES ),
( String
"inline", Bool -> Token
INLINE Bool
True ),
( String
"noinline", Bool -> Token
INLINE Bool
False ),
( String
"notinline", Bool -> Token
INLINE Bool
False ),
( String
"specialise", Token
SPECIALISE ),
( String
"specialize", Token
SPECIALISE ),
( String
"source", Token
SOURCE ),
( String
"deprecated", Token
DEPRECATED ),
( String
"warning", Token
WARNING ),
( String
"ann", Token
ANN ),
( String
"scc", Token
SCC ),
( String
"generated", Token
GENERATED ),
( String
"core", Token
CORE ),
( String
"unpack", Token
UNPACK ),
( String
"nounpack", Token
NOUNPACK ),
( String
"language", Token
LANGUAGE ),
( String
"minimal", Token
MINIMAL ),
( String
"no_overlap", Token
NO_OVERLAP ),
( String
"overlap", Token
OVERLAP ),
( String
"overlaps", Token
OVERLAPS ),
( String
"overlapping", Token
OVERLAPPING ),
( String
"overlappable", Token
OVERLAPPABLE ),
( String
"incoherent", Token
INCOHERENT ),
( String
"complete", Token
COMPLETE ),
( String
"options", (Maybe String, String) -> Token
OPTIONS forall a. HasCallStack => a
undefined )
]
isIdent, isHSymbol, isPragmaChar :: Char -> Bool
isIdent :: Char -> Bool
isIdent Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
isHSymbol :: Char -> Bool
isHSymbol Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
":!#%&*./?@\\-" Bool -> Bool -> Bool
|| ((Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"(),;[]`{}_\"'"))
isPragmaChar :: Char -> Bool
isPragmaChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
isIdentStart :: Char -> Bool
isIdentStart :: Char -> Bool
isIdentStart Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isUpper Char
c) Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
isOpSymbol :: Char -> Bool
isOpSymbol :: Char -> Bool
isOpSymbol Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!#$%&*+./<=>?@\\^|-~"
isPossiblyQvar :: Char -> Bool
isPossiblyQvar :: Char -> Bool
isPossiblyQvar Char
c = Char -> Bool
isIdent (Char -> Char
toLower Char
c) Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'
matchChar :: Char -> String -> Lex a ()
matchChar :: forall a. Char -> String -> Lex a ()
matchChar Char
c String
msg = do
String
s <- forall r. Lex r String
getInput
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s Bool -> Bool -> Bool
|| forall a. [a] -> a
head String
s forall a. Eq a => a -> a -> Bool
/= Char
c then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg else forall r. Int -> Lex r ()
discard Int
1
lexer :: (Loc Token -> P a) -> P a
lexer :: forall a. (Loc Token -> P a) -> P a
lexer = forall r a. Lex r a -> (a -> P r) -> P r
runL forall a. Lex a (Loc Token)
topLexer
topLexer :: Lex a (Loc Token)
topLexer :: forall a. Lex a (Loc Token)
topLexer = do
Bool
b <- forall a. Lex a Bool
pullCtxtFlag
if Bool
b then
forall a. Lex a ()
setBOL forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Lex a SrcLoc
getSrcLocL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SrcLoc
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. SrcSpan -> a -> Loc a
Loc (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
l SrcLoc
l) Token
VRightCurly)
else do
Bool
bol <- forall a. Lex a Bool
checkBOL
(Bool
bol', Bool
ws) <- forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
bol
Maybe ExtContext
ec <- forall a. Lex a (Maybe ExtContext)
getExtContext
case Maybe ExtContext
ec of
Just ExtContext
ChildCtxt | Bool -> Bool
not Bool
bol' Bool -> Bool -> Bool
&& Bool
ws -> forall a. Lex a SrcLoc
getSrcLocL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SrcLoc
l -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> a -> Loc a
Loc (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
l SrcLoc
l) forall a b. (a -> b) -> a -> b
$ String -> Token
XPCDATA String
" "
Maybe ExtContext
_ -> do forall a. Lex a ()
startToken
SrcLoc
sl <- forall a. Lex a SrcLoc
getSrcLocL
Token
t <- if Bool
bol' then forall a. Lex a Token
lexBOL
else forall a. Lex a Token
lexToken
SrcLoc
el <- forall a. Lex a SrcLoc
getSrcLocL
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> a -> Loc a
Loc (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
sl SrcLoc
el) Token
t
lexWhiteSpace :: Bool -> Lex a (Bool, Bool)
lexWhiteSpace :: forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
bol = do
String
s <- forall r. Lex r String
getInput
Bool
ignL <- forall a. Lex a Bool
ignoreLinePragmasL
case String
s of
Char
'{':Char
'-':Char
'#':String
rest | String -> Bool
isRecognisedPragma String
rest -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
bol, Bool
False)
| String -> Bool
isLinePragma String
rest Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ignL -> do
(Int
l, String
fn) <- forall a. Lex a (Int, String)
lexLinePragma
forall r. Int -> Lex r ()
setSrcLineL Int
l
forall a. String -> Lex a ()
setLineFilenameL String
fn
forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
True
Char
'{':Char
'-':String
_ -> do
SrcLoc
loc <- forall a. Lex a SrcLoc
getSrcLocL
forall r. Int -> Lex r ()
discard Int
2
(Bool
bol1, String
c) <- forall a. Bool -> String -> Lex a (Bool, String)
lexNestedComment Bool
bol String
""
SrcLoc
loc2 <- forall a. Lex a SrcLoc
getSrcLocL
forall a. Comment -> Lex a ()
pushComment forall a b. (a -> b) -> a -> b
$ Bool -> SrcSpan -> String -> Comment
Comment Bool
True (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
loc SrcLoc
loc2) (forall a. [a] -> [a]
reverse String
c)
(Bool
bol2, Bool
_) <- forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
bol1
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
bol2, Bool
True)
Char
'-':Char
'-':String
s1 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Char
'-') (forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isHSymbol String
s1) -> do
SrcLoc
loc <- forall a. Lex a SrcLoc
getSrcLocL
forall r. Int -> Lex r ()
discard Int
2
String
dashes <- forall a. (Char -> Bool) -> Lex a String
lexWhile (forall a. Eq a => a -> a -> Bool
== Char
'-')
String
rest <- forall a. (Char -> Bool) -> Lex a String
lexWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
String
s' <- forall r. Lex r String
getInput
SrcLoc
loc2 <- forall a. Lex a SrcLoc
getSrcLocL
let com :: Comment
com = Bool -> SrcSpan -> String -> Comment
Comment Bool
False (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
loc SrcLoc
loc2) forall a b. (a -> b) -> a -> b
$ String
dashes forall a. [a] -> [a] -> [a]
++ String
rest
case String
s' of
[] -> forall a. Comment -> Lex a ()
pushComment Comment
com forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
True)
String
_ -> do
forall a. Comment -> Lex a ()
pushComment Comment
com
forall a. Lex a ()
lexNewline
forall a. Bool -> Lex a ()
lexWhiteSpace_ Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Bool
True)
Char
'\n':String
_ -> do
forall a. Lex a ()
lexNewline
forall a. Bool -> Lex a ()
lexWhiteSpace_ Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Bool
True)
Char
'\t':String
_ -> do
forall a. Lex a ()
lexTab
(Bool
bol', Bool
_) <- forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
bol
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
bol', Bool
True)
Char
c:String
_ | Char -> Bool
isSpace Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
(Bool
bol', Bool
_) <- forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
bol
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
bol', Bool
True)
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
bol, Bool
False)
lexWhiteSpace_ :: Bool -> Lex a ()
lexWhiteSpace_ :: forall a. Bool -> Lex a ()
lexWhiteSpace_ Bool
bol = do (Bool, Bool)
_ <- forall a. Bool -> Lex a (Bool, Bool)
lexWhiteSpace Bool
bol
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isRecognisedPragma, isLinePragma :: String -> Bool
isRecognisedPragma :: String -> Bool
isRecognisedPragma String
str = let pragma :: String
pragma = forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isPragmaChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ String
str
in case String -> Maybe Token
lookupKnownPragma String
pragma of
Maybe Token
Nothing -> Bool
False
Maybe Token
_ -> Bool
True
isLinePragma :: String -> Bool
isLinePragma String
str = let pragma :: String
pragma = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isAlphaNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ String
str
in case String
pragma of
String
"line" -> Bool
True
String
_ -> Bool
False
lexLinePragma :: Lex a (Int, String)
lexLinePragma :: forall a. Lex a (Int, String)
lexLinePragma = do
forall r. Int -> Lex r ()
discard Int
3
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
forall r. Int -> Lex r ()
discard Int
4
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
String
i <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isDigit
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Improperly formatted LINE pragma"
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
forall a. Char -> String -> Lex a ()
matchChar Char
'"' String
"Improperly formatted LINE pragma"
String
fn <- forall a. (Char -> Bool) -> Lex a String
lexWhile (forall a. Eq a => a -> a -> Bool
/= Char
'"')
forall a. Char -> String -> Lex a ()
matchChar Char
'"' String
"Impossible - lexLinePragma"
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Char -> String -> Lex a ()
matchChar String
"Improperly formatted LINE pragma") String
"#-}"
forall a. Lex a ()
lexNewline
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Read a => String -> a
read String
i, String
fn)
lexNestedComment :: Bool -> String -> Lex a (Bool, String)
Bool
bol String
str = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'-':Char
'}':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
bol, String
str)
Char
'{':Char
'-':String
_ -> do
forall r. Int -> Lex r ()
discard Int
2
(Bool
bol', String
c) <- forall a. Bool -> String -> Lex a (Bool, String)
lexNestedComment Bool
bol (String
"-{" forall a. [a] -> [a] -> [a]
++ String
str)
forall a. Bool -> String -> Lex a (Bool, String)
lexNestedComment Bool
bol' (String
"}-" forall a. [a] -> [a] -> [a]
++ String
c )
Char
'\t':String
_ -> forall a. Lex a ()
lexTab forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Bool -> String -> Lex a (Bool, String)
lexNestedComment Bool
bol (Char
'\t'forall a. a -> [a] -> [a]
:String
str)
Char
'\n':String
_ -> forall a. Lex a ()
lexNewline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Bool -> String -> Lex a (Bool, String)
lexNestedComment Bool
True (Char
'\n'forall a. a -> [a] -> [a]
:String
str)
Char
c:String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Bool -> String -> Lex a (Bool, String)
lexNestedComment Bool
bol (Char
cforall a. a -> [a] -> [a]
:String
str)
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unterminated nested comment"
lexBOL :: Lex a Token
lexBOL :: forall a. Lex a Token
lexBOL = do
Ordering
pos <- forall a. Lex a Ordering
getOffside
case Ordering
pos of
Ordering
LT -> do
forall a. Lex a ()
setBOL
forall a. String -> Lex a ()
popContextL String
"lexBOL"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
VRightCurly
Ordering
EQ ->
forall (m :: * -> *) a. Monad m => a -> m a
return Token
SemiColon
Ordering
GT -> forall a. Lex a Token
lexToken
lexToken :: Lex a Token
lexToken :: forall a. Lex a Token
lexToken = do
Maybe ExtContext
ec <- forall a. Lex a (Maybe ExtContext)
getExtContext
case Maybe ExtContext
ec of
Just ExtContext
HarpCtxt -> forall a. Lex a Token
lexHarpToken
Just ExtContext
TagCtxt -> forall a. Lex a Token
lexTagCtxt
Just ExtContext
CloseTagCtxt -> forall a. Lex a Token
lexCloseTagCtxt
Just ExtContext
ChildCtxt -> forall a. Lex a Token
lexChildCtxt
Just ExtContext
CodeTagCtxt -> forall a. Lex a Token
lexCodeTagCtxt
Maybe ExtContext
_ -> forall a. Lex a Token
lexStdToken
lexChildCtxt :: Lex a Token
lexChildCtxt :: forall a. Lex a Token
lexChildCtxt = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'<':Char
'%':Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
3
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
ChildCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XChildTagOpen
Char
'<':Char
'%':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
CodeTagCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XCodeTagOpen
Char
'<':Char
'/':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. String -> Lex a ()
popExtContextL String
"lexChildCtxt"
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
CloseTagCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XCloseTagOpen
Char
'<':Char
'[':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
HarpCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XRPatOpen
Char
'<':String
_ -> do forall r. Int -> Lex r ()
discard Int
1
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
TagCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XStdTagOpen
String
_ -> forall a. Lex a Token
lexPCDATA
lexPCDATA :: Lex a Token
lexPCDATA :: forall a. Lex a Token
lexPCDATA = do
String
s <- forall r. Lex r String
getInput
case String
s of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
EOF
String
_ -> case String
s of
Char
'\n':String
_ -> do
Token
x <- forall a. Lex a ()
lexNewline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Lex a Token
lexPCDATA
case Token
x of
XPCDATA String
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
XPCDATA forall a b. (a -> b) -> a -> b
$ Char
'\n'forall a. a -> [a] -> [a]
:String
p
Token
EOF -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
EOF
Token
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"lexPCDATA: unexpected token: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
x
Char
'<':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
XPCDATA String
""
String
_ -> do let pcd :: String
pcd = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"<\n") String
s
l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pcd
forall r. Int -> Lex r ()
discard Int
l
Token
x <- forall a. Lex a Token
lexPCDATA
case Token
x of
XPCDATA String
pcd' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
XPCDATA forall a b. (a -> b) -> a -> b
$ String
pcd forall a. [a] -> [a] -> [a]
++ String
pcd'
Token
EOF -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
EOF
Token
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"lexPCDATA: unexpected token: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
x
lexCodeTagCtxt :: Lex a Token
lexCodeTagCtxt :: forall a. Lex a Token
lexCodeTagCtxt = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'%':Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. String -> Lex a ()
popExtContextL String
"lexCodeTagContext"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XCodeTagClose
String
_ -> forall a. Lex a Token
lexStdToken
lexCloseTagCtxt :: Lex a Token
lexCloseTagCtxt :: forall a. Lex a Token
lexCloseTagCtxt = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'%':Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. String -> Lex a ()
popExtContextL String
"lexCloseTagCtxt"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XCodeTagClose
Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
1
forall a. String -> Lex a ()
popExtContextL String
"lexCloseTagCtxt"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XStdTagClose
String
_ -> forall a. Lex a Token
lexStdToken
lexTagCtxt :: Lex a Token
lexTagCtxt :: forall a. Lex a Token
lexTagCtxt = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'/':Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. String -> Lex a ()
popExtContextL String
"lexTagCtxt: Empty tag"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XEmptyTagClose
Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
1
forall a. String -> Lex a ()
popExtContextL String
"lexTagCtxt: Standard tag"
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
ChildCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XStdTagClose
String
_ -> forall a. Lex a Token
lexStdToken
lexHarpToken :: Lex a Token
lexHarpToken :: forall a. Lex a Token
lexHarpToken = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
']':Char
'>':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. String -> Lex a ()
popExtContextL String
"lexHarpToken"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XRPatClose
String
_ -> forall a. Lex a Token
lexStdToken
lexStdToken :: Lex a Token
lexStdToken :: forall a. Lex a Token
lexStdToken = do
String
s <- forall r. Lex r String
getInput
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
let intHash :: Lex a ((Integer, String) -> Token)
intHash = forall b a.
(b -> Token)
-> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash (Integer, String) -> Token
IntTok (Integer, String) -> Token
IntTokHash (forall a b. b -> Either a b
Right (Integer, String) -> Token
WordTokHash)
case String
s of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
EOF
Char
'0':Char
c:Char
d:String
_ | Char -> Char
toLower Char
c forall a. Eq a => a -> a -> Bool
== Char
'o' Bool -> Bool -> Bool
&& Char -> Bool
isOctDigit Char
d -> do
forall r. Int -> Lex r ()
discard Int
2
(Integer
n, String
str) <- forall a. Lex a (Integer, String)
lexOctal
(Integer, String) -> Token
con <- forall {a}. Lex a ((Integer, String) -> Token)
intHash
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, String) -> Token
con (Integer
n, Char
'0'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
str))
| Char -> Char
toLower Char
c forall a. Eq a => a -> a -> Bool
== Char
'b' Bool -> Bool -> Bool
&& Char -> Bool
isBinDigit Char
d Bool -> Bool -> Bool
&& KnownExtension
BinaryLiterals forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
2
(Integer
n, String
str) <- forall a. Lex a (Integer, String)
lexBinary
(Integer, String) -> Token
con <- forall {a}. Lex a ((Integer, String) -> Token)
intHash
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, String) -> Token
con (Integer
n, Char
'0'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
str))
| Char -> Char
toLower Char
c forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
d -> do
forall r. Int -> Lex r ()
discard Int
2
(Integer
n, String
str) <- forall a. Lex a (Integer, String)
lexHexadecimal
(Integer, String) -> Token
con <- forall {a}. Lex a ((Integer, String) -> Token)
intHash
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, String) -> Token
con (Integer
n, Char
'0'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
str))
Char
'?':Char
c:String
_ | Char -> Bool
isIdentStart Char
c Bool -> Bool -> Bool
&& KnownExtension
ImplicitParams forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
1
String
id <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
IDupVarId String
id
Char
'%':Char
c:String
_ | Char -> Bool
isIdentStart Char
c Bool -> Bool -> Bool
&& KnownExtension
ImplicitParams forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
1
String
id <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
ILinVarId String
id
Char
'(':Char
'|':Char
c:String
_ | KnownExtension
RegularPatterns forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isHSymbol Char
c) ->
forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
RPGuardOpen
| KnownExtension
Arrows forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isHSymbol Char
c) ->
forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
OpenArrowBracket
Char
'|':Char
')':String
_ | KnownExtension
RegularPatterns forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
RPGuardClose
| KnownExtension
Arrows forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
CloseArrowBracket
Char
'[':Char
'|':Char
'|':String
_ | KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THTExpQuote
Char
'[':Char
'e':Char
'|':Char
'|':String
_ | KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
4
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THTExpQuote
Char
'[':Char
'|':String
_ | KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THExpQuote
Char
'[':Char
c:Char
'|':String
_ | Char
c forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THExpQuote
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'p' Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THPatQuote
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'd' Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THDecQuote
| Char
c forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THTypQuote
Char
'[':Char
'$':Char
c:String
_ | Char -> Bool
isIdentStart Char
c Bool -> Bool -> Bool
&& KnownExtension
QuasiQuotes forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts ->
forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Char -> Lex a Token
lexQuasiQuote Char
c
Char
'[':Char
c:String
s' | Char -> Bool
isIdentStart Char
c Bool -> Bool -> Bool
&& KnownExtension
QuasiQuotes forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts Bool -> Bool -> Bool
&& case forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isIdent String
s' of { Char
'|':String
_ -> Bool
True;String
_->Bool
False} ->
forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Char -> Lex a Token
lexQuasiQuote Char
c
| Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
&& KnownExtension
QuasiQuotes forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts Bool -> Bool -> Bool
&& case forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPossiblyQvar String
s' of { Char
'|':String
_ -> Bool
True;String
_->Bool
False} ->
forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Char -> Lex a Token
lexQuasiQuote Char
c
Char
'|':Char
'|':Char
']':String
_ | KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THTCloseQuote
Char
'|':Char
']':String
_ | KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THCloseQuote
Char
'$':Char
c1:Char
c2:String
_ | Char -> Bool
isIdentStart Char
c1 Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
1
String
id <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
THIdEscape String
id
| Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THParenEscape
| Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
&& Char -> Bool
isIdentStart Char
c2 Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
2
String
id <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
THTIdEscape String
id
| Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
&& Char
c2 forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return Token
THTParenEscape
Char
'<':Char
'%':Char
c:String
_ | KnownExtension
XmlSyntax forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts ->
case Char
c of
Char
'>' -> do forall r. Int -> Lex r ()
discard Int
3
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
ChildCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XChildTagOpen
Char
_ -> do forall r. Int -> Lex r ()
discard Int
2
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
CodeTagCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XCodeTagOpen
Char
'<':Char
c:String
_ | Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& KnownExtension
XmlSyntax forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
1
forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
TagCtxt
forall (m :: * -> *) a. Monad m => a -> m a
return Token
XStdTagOpen
Char
'(':Char
'#':Char
c:String
_ | [KnownExtension] -> Bool
unboxed [KnownExtension]
exts Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isHSymbol Char
c) -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
LeftHashParen
Char
'#':Char
')':String
_ | [KnownExtension] -> Bool
unboxed [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
RightHashParen
Char
'{':Char
'-':Char
'#':String
_ -> forall a. Lex a ()
saveExtensionsL forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Lex a Token
lexPragmaStart
Char
'#':Char
'-':Char
'}':String
_ -> forall a. Lex a ()
restoreExtensionsL forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
PragmaEnd
Char
'[':Char
':':String
_ | KnownExtension
ParallelArrays forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
ParArrayLeftSquare
Char
':':Char
']':String
_ | KnownExtension
ParallelArrays forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
ParArrayRightSquare
Char
'@':Char
c:String
_ | KnownExtension
TypeApplications forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts
Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isOpSymbol Char
c) -> do
Char
lc <- forall r. Lex r Char
getLastChar
if Char -> Bool
isIdent Char
lc
then forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
At
else forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
TApp
Char
'#':Char
c:String
_ | KnownExtension
OverloadedLabels forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts
Bool -> Bool -> Bool
&& Char -> Bool
isIdentStart Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
[String
ident] <- forall a. Lex a [String]
lexIdents
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
LabelVarId String
ident
Char
c:String
_ | Char -> Bool
isDigit Char
c -> forall a. Lex a Token
lexDecimalOrFloat
| Char -> Bool
isUpper Char
c -> forall a. String -> Lex a Token
lexConIdOrQual String
""
| Char -> Bool
isIdentStart Char
c -> do
[String]
idents <- forall a. Lex a [String]
lexIdents
case [String]
idents of
[String
ident] -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
ident ([(String, (Token, Maybe ExtScheme))]
reserved_ids forall a. [a] -> [a] -> [a]
++ [(String, (Token, Maybe ExtScheme))]
special_varids) of
Just (Token
keyword, Maybe ExtScheme
scheme) ->
if forall a. Enabled a => a -> [KnownExtension] -> Bool
isEnabled Maybe ExtScheme
scheme [KnownExtension]
exts
then forall a. Token -> Lex a ()
flagKW Token
keyword forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
keyword
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
VarId String
ident
Maybe (Token, Maybe ExtScheme)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
VarId String
ident
[String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> Token
DVarId [String]
idents
| Char -> Bool
isHSymbol Char
c -> do
String
sym <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isHSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
sym ([(String, (Token, Maybe ExtScheme))]
reserved_ops forall a. [a] -> [a] -> [a]
++ [(String, (Token, Maybe ExtScheme))]
special_varops) of
Just (Token
t , Maybe ExtScheme
scheme) ->
if forall a. Enabled a => a -> [KnownExtension] -> Bool
isEnabled Maybe ExtScheme
scheme [KnownExtension]
exts
then Token
t
else case Char
c of
Char
':' -> String -> Token
ConSym String
sym
Char
_ -> String -> Token
VarSym String
sym
Maybe (Token, Maybe ExtScheme)
Nothing -> case Char
c of
Char
':' -> String -> Token
ConSym String
sym
Char
_ -> String -> Token
VarSym String
sym
| Bool
otherwise -> do
forall r. Int -> Lex r ()
discard Int
1
case Char
c of
Char
'(' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
LeftParen
Char
')' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
RightParen
Char
',' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
Comma
Char
';' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
SemiColon
Char
'[' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
LeftSquare
Char
']' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
RightSquare
Char
'`' -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
BackQuote
Char
'{' -> do
forall a. LexContext -> Lex a ()
pushContextL LexContext
NoLayout
forall (m :: * -> *) a. Monad m => a -> m a
return Token
LeftCurly
Char
'}' -> do
forall a. String -> Lex a ()
popContextL String
"lexStdToken"
forall (m :: * -> *) a. Monad m => a -> m a
return Token
RightCurly
Char
'\'' -> forall a. Lex a Token
lexCharacter
Char
'"' -> forall a. Lex a Token
lexString
Char
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Illegal character \'" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c forall a. [a] -> [a] -> [a]
++ String
"\'\n")
where lexIdents :: Lex a [String]
lexIdents :: forall a. Lex a [String]
lexIdents = do
String
ident <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
String
s <- forall r. Lex r String
getInput
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
case String
s of
Char
'-':Char
c:String
_ | KnownExtension
XmlSyntax forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
[String]
idents <- forall a. Lex a [String]
lexIdents
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
ident forall a. a -> [a] -> [a]
: [String]
idents
Char
'#':String
_ | KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
String
hashes <- forall a. (Char -> Bool) -> Lex a String
lexWhile (forall a. Eq a => a -> a -> Bool
== Char
'#')
forall (m :: * -> *) a. Monad m => a -> m a
return [String
ident forall a. [a] -> [a] -> [a]
++ String
hashes]
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [String
ident]
lexQuasiQuote :: Char -> Lex a Token
lexQuasiQuote :: forall a. Char -> Lex a Token
lexQuasiQuote Char
c = do
String
ident <- forall r. Lex r String
lexQuoter
forall a. Char -> String -> Lex a ()
matchChar Char
'|' String
"Malformed quasi-quote quoter"
String
body <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String, String) -> Token
THQuasiQuote (String
ident, String
body)
where lexQuoter :: Lex a String
lexQuoter
| Char -> Bool
isIdentStart Char
c = forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
| Bool
otherwise = do
Token
qualThing <- forall a. String -> Lex a Token
lexConIdOrQual String
""
case Token
qualThing of
QVarId (String
s1,String
s2) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
s1 forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
s2
QVarSym (String
s1, String
s2) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
s1 forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
s2
Token
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Malformed quasi-quote quoter"
lexQQBody :: Lex a String
lexQQBody :: forall r. Lex r String
lexQQBody = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'\\':Char
']':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
String
str <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
']'forall a. a -> [a] -> [a]
:String
str)
Char
'\\':Char
'|':String
_ -> do forall r. Int -> Lex r ()
discard Int
2
String
str <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'|'forall a. a -> [a] -> [a]
:String
str)
Char
'|':Char
']':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Char
'|':String
_ -> do forall r. Int -> Lex r ()
discard Int
1
String
str <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'|'forall a. a -> [a] -> [a]
:String
str)
Char
']':String
_ -> do forall r. Int -> Lex r ()
discard Int
1
String
str <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
']'forall a. a -> [a] -> [a]
:String
str)
Char
'\\':String
_ -> do forall r. Int -> Lex r ()
discard Int
1
String
str <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'forall a. a -> [a] -> [a]
:String
str)
Char
'\n':String
_ -> do forall a. Lex a ()
lexNewline
String
str <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\n'forall a. a -> [a] -> [a]
:String
str)
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected end of input while lexing quasi-quoter"
String
_ -> do String
str <- forall a. (Char -> Bool) -> Lex a String
lexWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\\|\n"))
String
rest <- forall r. Lex r String
lexQQBody
forall (m :: * -> *) a. Monad m => a -> m a
return (String
strforall a. [a] -> [a] -> [a]
++String
rest)
unboxed :: [KnownExtension] -> Bool
unboxed :: [KnownExtension] -> Bool
unboxed [KnownExtension]
exts = KnownExtension
UnboxedSums forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts Bool -> Bool -> Bool
|| KnownExtension
UnboxedTuples forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts
lookupKnownPragma :: String -> Maybe Token
lookupKnownPragma :: String -> Maybe Token
lookupKnownPragma String
s =
case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
String
x | String
"options_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Maybe String, String) -> Token
OPTIONS (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
8 String
s, forall a. HasCallStack => a
undefined)
| String
"options" forall a. Eq a => a -> a -> Bool
== String
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Maybe String, String) -> Token
OPTIONS (forall a. Maybe a
Nothing, forall a. HasCallStack => a
undefined)
| Bool
otherwise -> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, Token)]
pragmas
lexPragmaStart :: Lex a Token
lexPragmaStart :: forall a. Lex a Token
lexPragmaStart = do
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
String
pr <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isPragmaChar
case String -> Maybe Token
lookupKnownPragma String
pr of
Just (INLINE Bool
True) -> do
String
s <- forall r. Lex r String
getInput
case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
Char
' ':Char
'c':Char
'o':Char
'n':Char
'l':Char
'i':Char
'k':Char
'e':String
_ -> do
forall r. Int -> Lex r ()
discard Int
8
forall (m :: * -> *) a. Monad m => a -> m a
return Token
INLINE_CONLIKE
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Token
INLINE Bool
True
Just Token
SPECIALISE -> do
String
s <- forall r. Lex r String
getInput
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
Char
'i':Char
'n':Char
'l':Char
'i':Char
'n':Char
'e':String
_ -> do
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
forall r. Int -> Lex r ()
discard Int
6
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Token
SPECIALISE_INLINE Bool
True
Char
'n':Char
'o':Char
'i':Char
'n':Char
'l':Char
'i':Char
'n':Char
'e':String
_ -> do
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
forall r. Int -> Lex r ()
discard Int
8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Token
SPECIALISE_INLINE Bool
False
Char
'n':Char
'o':Char
't':Char
'i':Char
'n':Char
'l':Char
'i':Char
'n':Char
'e':String
_ -> do
forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
isSpace
forall r. Int -> Lex r ()
discard Int
9
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Token
SPECIALISE_INLINE Bool
False
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
SPECIALISE
Just (OPTIONS (Maybe String, String)
opt) ->
let dropIfSpace :: ShowS
dropIfSpace (Char
' ':String
xs) = String
xs
dropIfSpace String
xs = String
xs
in
case forall a b. (a, b) -> a
fst (Maybe String, String)
opt of
Just String
opt' -> do
String
rest <- forall r. Lex r String
lexRawPragma
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Maybe String, String) -> Token
OPTIONS (forall a. a -> Maybe a
Just String
opt', ShowS
dropIfSpace String
rest)
Maybe String
Nothing -> do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
x:String
_ | Char -> Bool
isSpace Char
x -> do
String
rest <- forall r. Lex r String
lexRawPragma
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Maybe String, String) -> Token
OPTIONS (forall a. Maybe a
Nothing, ShowS
dropIfSpace String
rest)
String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Malformed Options pragma"
Just Token
RULES -> do
forall a. KnownExtension -> Lex a ()
addExtensionL KnownExtension
ScopedTypeVariables
forall (m :: * -> *) a. Monad m => a -> m a
return Token
RULES
Just Token
p -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
p
Maybe Token
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Internal error: Unrecognised recognised pragma"
lexRawPragma :: Lex a String
lexRawPragma :: forall r. Lex r String
lexRawPragma = forall r. Lex r String
lexRawPragmaAux
where lexRawPragmaAux :: Lex a String
lexRawPragmaAux = do
String
rpr <- forall a. (Char -> Bool) -> Lex a String
lexWhile (forall a. Eq a => a -> a -> Bool
/=Char
'#')
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'#':Char
'-':Char
'}':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
rpr
String
"" -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"End-of-file inside pragma"
String
_ -> do
forall r. Int -> Lex r ()
discard Int
1
String
rpr' <- forall r. Lex r String
lexRawPragma
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
rpr forall a. [a] -> [a] -> [a]
++ Char
'#'forall a. a -> [a] -> [a]
:String
rpr'
lexDecimalOrFloat :: Lex a Token
lexDecimalOrFloat :: forall a. Lex a Token
lexDecimalOrFloat = do
String
ds <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isDigit
String
rest <- forall r. Lex r String
getInput
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
case String
rest of
(Char
'.':Char
d:String
_) | Char -> Bool
isDigit Char
d -> do
forall r. Int -> Lex r ()
discard Int
1
String
frac <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isDigit
let num :: Integer
num = Integer -> String -> Integer
parseInteger Integer
10 (String
ds forall a. [a] -> [a] -> [a]
++ String
frac)
decimals :: Integer
decimals = forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
frac)
(Integer
exponent, String
estr) <- do
String
rest2 <- forall r. Lex r String
getInput
case String
rest2 of
Char
'e':String
_ -> forall a. Lex a (Integer, String)
lexExponent
Char
'E':String
_ -> forall a. Lex a (Integer, String)
lexExponent
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
0,String
"")
(Rational, String) -> Token
con <- forall b a.
(b -> Token)
-> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash (Rational, String) -> Token
FloatTok (Rational, String) -> Token
FloatTokHash (forall a b. b -> Either a b
Right (Rational, String) -> Token
DoubleTokHash)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Rational, String) -> Token
con ((Integer
numforall a. Integral a => a -> a -> Ratio a
%Integer
1) forall a. Num a => a -> a -> a
* Rational
10forall a b. (Fractional a, Integral b) => a -> b -> a
^^(Integer
exponent forall a. Num a => a -> a -> a
- Integer
decimals), String
ds forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
frac forall a. [a] -> [a] -> [a]
++ String
estr)
Char
e:String
_ | Char -> Char
toLower Char
e forall a. Eq a => a -> a -> Bool
== Char
'e' -> do
(Integer
exponent, String
estr) <- forall a. Lex a (Integer, String)
lexExponent
(Rational, String) -> Token
con <- forall b a.
(b -> Token)
-> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash (Rational, String) -> Token
FloatTok (Rational, String) -> Token
FloatTokHash (forall a b. b -> Either a b
Right (Rational, String) -> Token
DoubleTokHash)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Rational, String) -> Token
con ((Integer -> String -> Integer
parseInteger Integer
10 String
dsforall a. Integral a => a -> a -> Ratio a
%Integer
1) forall a. Num a => a -> a -> a
* Rational
10forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
exponent, String
ds forall a. [a] -> [a] -> [a]
++ String
estr)
Char
'#':Char
'#':String
_ | KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, String) -> Token
WordTokHash (Integer -> String -> Integer
parseInteger Integer
10 String
ds, String
ds))
Char
'#':String
_ | KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, String) -> Token
IntTokHash (Integer -> String -> Integer
parseInteger Integer
10 String
ds, String
ds))
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, String) -> Token
IntTok (Integer -> String -> Integer
parseInteger Integer
10 String
ds, String
ds))
where
lexExponent :: Lex a (Integer, String)
lexExponent :: forall a. Lex a (Integer, String)
lexExponent = do
(Char
e:String
r) <- forall r. Lex r String
getInput
forall r. Int -> Lex r ()
discard Int
1
case String
r of
Char
'+':Char
d:String
_ | Char -> Bool
isDigit Char
d -> do
forall r. Int -> Lex r ()
discard Int
1
(Integer
n, String
str) <- forall a. Lex a (Integer, String)
lexDecimal
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
n, Char
eforall a. a -> [a] -> [a]
:Char
'+'forall a. a -> [a] -> [a]
:String
str)
Char
'-':Char
d:String
_ | Char -> Bool
isDigit Char
d -> do
forall r. Int -> Lex r ()
discard Int
1
(Integer
n, String
str) <- forall a. Lex a (Integer, String)
lexDecimal
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a
negate Integer
n, Char
eforall a. a -> [a] -> [a]
:Char
'-'forall a. a -> [a] -> [a]
:String
str)
Char
d:String
_ | Char -> Bool
isDigit Char
d -> forall a. Lex a (Integer, String)
lexDecimal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
n,String
str) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
n, Char
eforall a. a -> [a] -> [a]
:String
str)
String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Float with missing exponent"
lexHash :: (b -> Token) -> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash :: forall b a.
(b -> Token)
-> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash b -> Token
a b -> Token
b Either String (b -> Token)
c = do
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
if KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts
then do
String
r <- forall r. Lex r String
getInput
case String
r of
Char
'#':Char
'#':String
_ -> case Either String (b -> Token)
c of
Right b -> Token
c' -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b -> Token
c'
Left String
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
Char
'#':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b -> Token
b
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return b -> Token
a
else forall (m :: * -> *) a. Monad m => a -> m a
return b -> Token
a
lexConIdOrQual :: String -> Lex a Token
lexConIdOrQual :: forall a. String -> Lex a Token
lexConIdOrQual String
qual = do
String
con <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
let conid :: Token
conid | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
qual = String -> Token
ConId String
con
| Bool
otherwise = (String, String) -> Token
QConId (String
qual,String
con)
qual' :: String
qual' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
qual = String
con
| Bool
otherwise = String
qual forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
con
Lex a Token
just_a_conid <- forall a v. Lex a v -> Lex a (Lex a v)
alternative (forall (m :: * -> *) a. Monad m => a -> m a
return Token
conid)
String
rest <- forall r. Lex r String
getInput
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
case String
rest of
Char
'.':Char
c:String
_
| Char -> Bool
isIdentStart Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
String
ident <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isIdent
String
s <- forall r. Lex r String
getInput
[KnownExtension]
exts' <- forall a. Lex a [KnownExtension]
getExtensionsL
String
ident' <- case String
s of
Char
'#':String
_ | KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts' -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (String
ident forall a. [a] -> [a] -> [a]
++ String
"#")
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
ident
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
ident' [(String, (Token, Maybe ExtScheme))]
reserved_ids of
Just (Token
_,Maybe ExtScheme
scheme) | forall a. Enabled a => a -> [KnownExtension] -> Bool
isEnabled Maybe ExtScheme
scheme [KnownExtension]
exts' -> Lex a Token
just_a_conid
Maybe (Token, Maybe ExtScheme)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> Token
QVarId (String
qual', String
ident'))
| Char -> Bool
isUpper Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
forall a. String -> Lex a Token
lexConIdOrQual String
qual'
| Char -> Bool
isHSymbol Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
String
sym <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isHSymbol
[KnownExtension]
exts' <- forall a. Lex a [KnownExtension]
getExtensionsL
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
sym [(String, (Token, Maybe ExtScheme))]
reserved_ops of
Just (Token
_,Maybe ExtScheme
scheme) | forall a. Enabled a => a -> [KnownExtension] -> Bool
isEnabled Maybe ExtScheme
scheme [KnownExtension]
exts' -> Lex a Token
just_a_conid
Maybe (Token, Maybe ExtScheme)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Char
c of
Char
':' -> (String, String) -> Token
QConSym (String
qual', String
sym)
Char
_ -> (String, String) -> Token
QVarSym (String
qual', String
sym)
Char
'#':String
cs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs Bool -> Bool -> Bool
||
Bool -> Bool
not (Char -> Bool
isHSymbol forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head String
cs) Bool -> Bool -> Bool
&&
Bool -> Bool
not (Char -> Bool
isIdent forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head String
cs) Bool -> Bool -> Bool
&& KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
1
case Token
conid of
ConId String
con' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
ConId forall a b. (a -> b) -> a -> b
$ String
con' forall a. [a] -> [a] -> [a]
++ String
"#"
QConId (String
q,String
con') -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String, String) -> Token
QConId (String
q,String
con' forall a. [a] -> [a] -> [a]
++ String
"#")
Token
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"lexConIdOrQual: unexpected token: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
conid
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
conid
lexCharacter :: Lex a Token
lexCharacter :: forall a. Lex a Token
lexCharacter = do
String
s <- forall r. Lex r String
getInput
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
case String
s of
Char
'\'':String
_ | KnownExtension
TemplateHaskell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Token
THTyQuote
Char
'\\':String
_ -> do
(Char
c,String
raw) <- forall a. Lex a (Char, String)
lexEscape
forall a. Lex a ()
matchQuote
(Char, String) -> Token
con <- forall b a.
(b -> Token)
-> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash (Char, String) -> Token
Character (Char, String) -> Token
CharacterHash
(forall a b. a -> Either a b
Left String
"Double hash not available for character literals")
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char, String) -> Token
con (Char
c, Char
'\\'forall a. a -> [a] -> [a]
:String
raw))
Char
c:Char
'\'':String
_ -> do
forall r. Int -> Lex r ()
discard Int
2
(Char, String) -> Token
con <- forall b a.
(b -> Token)
-> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
lexHash (Char, String) -> Token
Character (Char, String) -> Token
CharacterHash
(forall a b. a -> Either a b
Left String
"Double hash not available for character literals")
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char, String) -> Token
con (Char
c, [Char
c]))
String
_ | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts) [KnownExtension
TemplateHaskell, KnownExtension
DataKinds] -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
THVarQuote
String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Improper character constant or misplaced \'"
where matchQuote :: Lex a ()
matchQuote = forall a. Char -> String -> Lex a ()
matchChar Char
'\'' String
"Improperly terminated character constant"
lexString :: Lex a Token
lexString :: forall a. Lex a Token
lexString = forall {r}. (String, String) -> Lex r Token
loop (String
"",String
"")
where
loop :: (String, String) -> Lex r Token
loop (String
s,String
raw) = do
String
r <- forall r. Lex r String
getInput
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
case String
r of
Char
'\\':Char
'&':String
_ -> do
forall r. Int -> Lex r ()
discard Int
2
(String, String) -> Lex r Token
loop (String
s, Char
'&'forall a. a -> [a] -> [a]
:Char
'\\'forall a. a -> [a] -> [a]
:String
raw)
Char
'\\':Char
c:String
_ | Char -> Bool
isSpace Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
String
wcs <- forall r. Lex r String
lexWhiteChars
forall a. Char -> String -> Lex a ()
matchChar Char
'\\' String
"Illegal character in string gap"
(String, String) -> Lex r Token
loop (String
s, Char
'\\'forall a. a -> [a] -> [a]
:forall a. [a] -> [a]
reverse String
wcs forall a. [a] -> [a] -> [a]
++ Char
'\\'forall a. a -> [a] -> [a]
:String
raw)
| Bool
otherwise -> do
(Char
ce, String
str) <- forall a. Lex a (Char, String)
lexEscape
(String, String) -> Lex r Token
loop (Char
ceforall a. a -> [a] -> [a]
:String
s, forall a. [a] -> [a]
reverse String
str forall a. [a] -> [a] -> [a]
++ Char
'\\'forall a. a -> [a] -> [a]
:String
raw)
Char
'"':Char
'#':String
_ | KnownExtension
MagicHash forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts -> do
forall r. Int -> Lex r ()
discard Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> Token
StringHash (forall a. [a] -> [a]
reverse String
s, forall a. [a] -> [a]
reverse String
raw))
Char
'"':String
_ -> do
forall r. Int -> Lex r ()
discard Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> Token
StringTok (forall a. [a] -> [a]
reverse String
s, forall a. [a] -> [a]
reverse String
raw))
Char
c:String
_ | Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' -> do
forall r. Int -> Lex r ()
discard Int
1
(String, String) -> Lex r Token
loop (Char
cforall a. a -> [a] -> [a]
:String
s, Char
cforall a. a -> [a] -> [a]
:String
raw)
String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Improperly terminated string"
lexWhiteChars :: Lex a String
lexWhiteChars :: forall r. Lex r String
lexWhiteChars = do
String
s <- forall r. Lex r String
getInput
case String
s of
Char
'\n':String
_ -> do
forall a. Lex a ()
lexNewline
String
wcs <- forall r. Lex r String
lexWhiteChars
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'\n'forall a. a -> [a] -> [a]
:String
wcs
Char
'\t':String
_ -> do
forall a. Lex a ()
lexTab
String
wcs <- forall r. Lex r String
lexWhiteChars
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'\t'forall a. a -> [a] -> [a]
:String
wcs
Char
c:String
_ | Char -> Bool
isSpace Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
String
wcs <- forall r. Lex r String
lexWhiteChars
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
cforall a. a -> [a] -> [a]
:String
wcs
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
lexEscape :: Lex a (Char, String)
lexEscape :: forall a. Lex a (Char, String)
lexEscape = do
forall r. Int -> Lex r ()
discard Int
1
String
r <- forall r. Lex r String
getInput
case String
r of
Char
'a':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\a', String
"a")
Char
'b':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\b', String
"b")
Char
'f':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\f', String
"f")
Char
'n':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\n', String
"n")
Char
'r':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\r', String
"r")
Char
't':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\t', String
"t")
Char
'v':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\v', String
"v")
Char
'\\':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\', String
"\\")
Char
'"':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\"', String
"\"")
Char
'\'':String
_ -> forall r. Int -> Lex r ()
discard Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\'', String
"\'")
Char
'^':Char
c:String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Char -> Lex a (Char, String)
cntrl Char
c
Char
'N':Char
'U':Char
'L':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\NUL', String
"NUL")
Char
'S':Char
'O':Char
'H':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\SOH', String
"SOH")
Char
'S':Char
'T':Char
'X':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\STX', String
"STX")
Char
'E':Char
'T':Char
'X':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\ETX', String
"ETX")
Char
'E':Char
'O':Char
'T':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\EOT', String
"EOT")
Char
'E':Char
'N':Char
'Q':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\ENQ', String
"ENQ")
Char
'A':Char
'C':Char
'K':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\ACK', String
"ACK")
Char
'B':Char
'E':Char
'L':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\BEL', String
"BEL")
Char
'B':Char
'S':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\BS', String
"BS")
Char
'H':Char
'T':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\HT', String
"HT")
Char
'L':Char
'F':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\LF', String
"LF")
Char
'V':Char
'T':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\VT', String
"VT")
Char
'F':Char
'F':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\FF', String
"FF")
Char
'C':Char
'R':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\CR', String
"CR")
Char
'S':Char
'O':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\SO', String
"SO")
Char
'S':Char
'I':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\SI', String
"SI")
Char
'D':Char
'L':Char
'E':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\DLE', String
"DLE")
Char
'D':Char
'C':Char
'1':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\DC1', String
"DC1")
Char
'D':Char
'C':Char
'2':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\DC2', String
"DC2")
Char
'D':Char
'C':Char
'3':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\DC3', String
"DC3")
Char
'D':Char
'C':Char
'4':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\DC4', String
"DC4")
Char
'N':Char
'A':Char
'K':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\NAK', String
"NAK")
Char
'S':Char
'Y':Char
'N':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\SYN', String
"SYN")
Char
'E':Char
'T':Char
'B':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\ETB', String
"ETB")
Char
'C':Char
'A':Char
'N':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\CAN', String
"CAN")
Char
'E':Char
'M':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\EM', String
"EM")
Char
'S':Char
'U':Char
'B':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\SUB', String
"SUB")
Char
'E':Char
'S':Char
'C':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\ESC', String
"ESC")
Char
'F':Char
'S':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\FS', String
"FS")
Char
'G':Char
'S':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\GS', String
"GS")
Char
'R':Char
'S':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\RS', String
"RS")
Char
'U':Char
'S':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\US', String
"US")
Char
'S':Char
'P':String
_ -> forall r. Int -> Lex r ()
discard Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\SP', String
"SP")
Char
'D':Char
'E':Char
'L':String
_ -> forall r. Int -> Lex r ()
discard Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\DEL', String
"DEL")
Char
'o':Char
c:String
_ | Char -> Bool
isOctDigit Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
(Integer
n, String
raw) <- forall a. Lex a (Integer, String)
lexOctal
Char
n' <- forall {m :: * -> *}. MonadFail m => Integer -> m Char
checkChar Integer
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
n', Char
'o'forall a. a -> [a] -> [a]
:String
raw)
Char
'x':Char
c:String
_ | Char -> Bool
isHexDigit Char
c -> do
forall r. Int -> Lex r ()
discard Int
1
(Integer
n, String
raw) <- forall a. Lex a (Integer, String)
lexHexadecimal
Char
n' <- forall {m :: * -> *}. MonadFail m => Integer -> m Char
checkChar Integer
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
n', Char
'x'forall a. a -> [a] -> [a]
:String
raw)
Char
c:String
_ | Char -> Bool
isDigit Char
c -> do
(Integer
n, String
raw) <- forall a. Lex a (Integer, String)
lexDecimal
Char
n' <- forall {m :: * -> *}. MonadFail m => Integer -> m Char
checkChar Integer
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
n', String
raw)
String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Illegal escape sequence"
where
checkChar :: Integer -> m Char
checkChar Integer
n | Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
0x10FFFF = forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr (forall a. Num a => Integer -> a
fromInteger Integer
n))
checkChar Integer
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Character constant out of range"
cntrl :: Char -> Lex a (Char, String)
cntrl :: forall a. Char -> Lex a (Char, String)
cntrl Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'@' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'_' = forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'@'), Char
'^'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:[])
cntrl Char
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Illegal control character"
lexOctal :: Lex a (Integer, String)
lexOctal :: forall a. Lex a (Integer, String)
lexOctal = do
String
ds <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isOctDigit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> String -> Integer
parseInteger Integer
8 String
ds, String
ds)
lexBinary :: Lex a (Integer, String)
lexBinary :: forall a. Lex a (Integer, String)
lexBinary = do
String
ds <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isBinDigit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> String -> Integer
parseInteger Integer
2 String
ds, String
ds)
lexHexadecimal :: Lex a (Integer, String)
lexHexadecimal :: forall a. Lex a (Integer, String)
lexHexadecimal = do
String
ds <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isHexDigit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> String -> Integer
parseInteger Integer
16 String
ds, String
ds)
lexDecimal :: Lex a (Integer, String)
lexDecimal :: forall a. Lex a (Integer, String)
lexDecimal = do
String
ds <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
isDigit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> String -> Integer
parseInteger Integer
10 String
ds, String
ds)
parseInteger :: Integer -> String -> Integer
parseInteger :: Integer -> String -> Integer
parseInteger Integer
radix String
ds =
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Integer
n Integer
d -> Integer
n forall a. Num a => a -> a -> a
* Integer
radix forall a. Num a => a -> a -> a
+ Integer
d) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) String
ds)
flagKW :: Token -> Lex a ()
flagKW :: forall a. Token -> Lex a ()
flagKW Token
t =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Token
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token
KW_Do, Token
KW_MDo]) forall a b. (a -> b) -> a -> b
$ do
[KnownExtension]
exts <- forall a. Lex a [KnownExtension]
getExtensionsL
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KnownExtension
NondecreasingIndentation forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KnownExtension]
exts) forall a. Lex a ()
flagDo
isBinDigit :: Char -> Bool
isBinDigit :: Char -> Bool
isBinDigit Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'1'
showToken :: Token -> String
showToken :: Token -> String
showToken Token
t = case Token
t of
VarId String
s -> String
s
LabelVarId String
s -> Char
'#'forall a. a -> [a] -> [a]
:String
s
QVarId (String
q,String
s) -> String
q forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
s
IDupVarId String
s -> Char
'?'forall a. a -> [a] -> [a]
:String
s
ILinVarId String
s -> Char
'%'forall a. a -> [a] -> [a]
:String
s
ConId String
s -> String
s
QConId (String
q,String
s) -> String
q forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
s
DVarId [String]
ss -> forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
ss
VarSym String
s -> String
s
ConSym String
s -> String
s
QVarSym (String
q,String
s) -> String
q forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
s
QConSym (String
q,String
s) -> String
q forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:String
s
IntTok (Integer
_, String
s) -> String
s
FloatTok (Rational
_, String
s) -> String
s
Character (Char
_, String
s) -> Char
'\''forall a. a -> [a] -> [a]
:String
s forall a. [a] -> [a] -> [a]
++ String
"'"
StringTok (String
_, String
s) -> Char
'"'forall a. a -> [a] -> [a]
:String
s forall a. [a] -> [a] -> [a]
++ String
"\""
IntTokHash (Integer
_, String
s) -> String
s forall a. [a] -> [a] -> [a]
++ String
"#"
WordTokHash (Integer
_, String
s) -> String
s forall a. [a] -> [a] -> [a]
++ String
"##"
FloatTokHash (Rational
_, String
s) -> String
s forall a. [a] -> [a] -> [a]
++ String
"#"
DoubleTokHash (Rational
_, String
s) -> String
s forall a. [a] -> [a] -> [a]
++ String
"##"
CharacterHash (Char
_, String
s) -> Char
'\''forall a. a -> [a] -> [a]
:String
s forall a. [a] -> [a] -> [a]
++ String
"'#"
StringHash (String
_, String
s) -> Char
'"'forall a. a -> [a] -> [a]
:String
s forall a. [a] -> [a] -> [a]
++ String
"\"#"
Token
LeftParen -> String
"("
Token
RightParen -> String
")"
Token
LeftHashParen -> String
"(#"
Token
RightHashParen -> String
"#)"
Token
SemiColon -> String
";"
Token
LeftCurly -> String
"{"
Token
RightCurly -> String
"}"
Token
VRightCurly -> String
"virtual }"
Token
LeftSquare -> String
"["
Token
RightSquare -> String
"]"
Token
ParArrayLeftSquare -> String
"[:"
Token
ParArrayRightSquare -> String
":]"
Token
Comma -> String
","
Token
Underscore -> String
"_"
Token
BackQuote -> String
"`"
Token
QuoteColon -> String
"':"
Token
Dot -> String
"."
Token
DotDot -> String
".."
Token
Colon -> String
":"
Token
DoubleColon -> String
"::"
Token
Equals -> String
"="
Token
Backslash -> String
"\\"
Token
Bar -> String
"|"
Token
LeftArrow -> String
"<-"
Token
RightArrow -> String
"->"
Token
At -> String
"@"
Token
TApp -> String
"@"
Token
Tilde -> String
"~"
Token
DoubleArrow -> String
"=>"
Token
Minus -> String
"-"
Token
Exclamation -> String
"!"
Token
Star -> String
"*"
Token
LeftArrowTail -> String
"-<"
Token
RightArrowTail -> String
">-"
Token
LeftDblArrowTail -> String
"-<<"
Token
RightDblArrowTail -> String
">>-"
Token
OpenArrowBracket -> String
"(|"
Token
CloseArrowBracket -> String
"|)"
Token
THExpQuote -> String
"[|"
Token
THTExpQuote -> String
"[||"
Token
THPatQuote -> String
"[p|"
Token
THDecQuote -> String
"[d|"
Token
THTypQuote -> String
"[t|"
Token
THCloseQuote -> String
"|]"
Token
THTCloseQuote -> String
"||]"
THIdEscape String
s -> Char
'$'forall a. a -> [a] -> [a]
:String
s
Token
THParenEscape -> String
"$("
THTIdEscape String
s -> String
"$$" forall a. [a] -> [a] -> [a]
++ String
s
Token
THTParenEscape -> String
"$$("
Token
THVarQuote -> String
"'"
Token
THTyQuote -> String
"''"
THQuasiQuote (String
n,String
q) -> String
"[$" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
q forall a. [a] -> [a] -> [a]
++ String
"]"
Token
RPGuardOpen -> String
"(|"
Token
RPGuardClose -> String
"|)"
Token
RPCAt -> String
"@:"
Token
XCodeTagOpen -> String
"<%"
Token
XCodeTagClose -> String
"%>"
Token
XStdTagOpen -> String
"<"
Token
XStdTagClose -> String
">"
Token
XCloseTagOpen -> String
"</"
Token
XEmptyTagClose -> String
"/>"
XPCDATA String
s -> String
"PCDATA " forall a. [a] -> [a] -> [a]
++ String
s
Token
XRPatOpen -> String
"<["
Token
XRPatClose -> String
"]>"
Token
PragmaEnd -> String
"#-}"
Token
RULES -> String
"{-# RULES"
INLINE Bool
b -> String
"{-# " forall a. [a] -> [a] -> [a]
++ if Bool
b then String
"INLINE" else String
"NOINLINE"
Token
INLINE_CONLIKE -> String
"{-# " forall a. [a] -> [a] -> [a]
++ String
"INLINE CONLIKE"
Token
SPECIALISE -> String
"{-# SPECIALISE"
SPECIALISE_INLINE Bool
b -> String
"{-# SPECIALISE " forall a. [a] -> [a] -> [a]
++ if Bool
b then String
"INLINE" else String
"NOINLINE"
Token
SOURCE -> String
"{-# SOURCE"
Token
DEPRECATED -> String
"{-# DEPRECATED"
Token
WARNING -> String
"{-# WARNING"
Token
SCC -> String
"{-# SCC"
Token
GENERATED -> String
"{-# GENERATED"
Token
CORE -> String
"{-# CORE"
Token
UNPACK -> String
"{-# UNPACK"
Token
NOUNPACK -> String
"{-# NOUNPACK"
OPTIONS (Maybe String
mt,String
_) -> String
"{-# OPTIONS" forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
':'forall a. a -> [a] -> [a]
:) Maybe String
mt forall a. [a] -> [a] -> [a]
++ String
" ..."
Token
LANGUAGE -> String
"{-# LANGUAGE"
Token
ANN -> String
"{-# ANN"
Token
MINIMAL -> String
"{-# MINIMAL"
Token
NO_OVERLAP -> String
"{-# NO_OVERLAP"
Token
OVERLAP -> String
"{-# OVERLAP"
Token
OVERLAPPING -> String
"{-# OVERLAPPING"
Token
OVERLAPPABLE -> String
"{-# OVERLAPPABLE"
Token
OVERLAPS -> String
"{-# OVERLAPS"
Token
INCOHERENT -> String
"{-# INCOHERENT"
Token
COMPLETE -> String
"{-# COMPLETE"
Token
KW_As -> String
"as"
Token
KW_By -> String
"by"
Token
KW_Case -> String
"case"
Token
KW_Class -> String
"class"
Token
KW_Data -> String
"data"
Token
KW_Default -> String
"default"
Token
KW_Deriving -> String
"deriving"
Token
KW_Do -> String
"do"
Token
KW_MDo -> String
"mdo"
Token
KW_Else -> String
"else"
Token
KW_Family -> String
"family"
Token
KW_Forall -> String
"forall"
Token
KW_Group -> String
"group"
Token
KW_Hiding -> String
"hiding"
Token
KW_If -> String
"if"
Token
KW_Import -> String
"import"
Token
KW_In -> String
"in"
Token
KW_Infix -> String
"infix"
Token
KW_InfixL -> String
"infixl"
Token
KW_InfixR -> String
"infixr"
Token
KW_Instance -> String
"instance"
Token
KW_Let -> String
"let"
Token
KW_Module -> String
"module"
Token
KW_NewType -> String
"newtype"
Token
KW_Of -> String
"of"
Token
KW_Proc -> String
"proc"
Token
KW_Rec -> String
"rec"
Token
KW_Then -> String
"then"
Token
KW_Type -> String
"type"
Token
KW_Using -> String
"using"
Token
KW_Where -> String
"where"
Token
KW_Qualified -> String
"qualified"
Token
KW_Foreign -> String
"foreign"
Token
KW_Export -> String
"export"
Token
KW_Safe -> String
"safe"
Token
KW_Unsafe -> String
"unsafe"
Token
KW_Threadsafe -> String
"threadsafe"
Token
KW_Interruptible -> String
"interruptible"
Token
KW_StdCall -> String
"stdcall"
Token
KW_CCall -> String
"ccall"
Token
XChildTagOpen -> String
"<%>"
Token
KW_CPlusPlus -> String
"cplusplus"
Token
KW_DotNet -> String
"dotnet"
Token
KW_Jvm -> String
"jvm"
Token
KW_Js -> String
"js"
Token
KW_JavaScript -> String
"javascript"
Token
KW_CApi -> String
"capi"
Token
KW_Role -> String
"role"
Token
KW_Pattern -> String
"pattern"
Token
KW_Stock -> String
"stock"
Token
KW_Anyclass -> String
"anyclass"
Token
KW_Via -> String
"via"
Token
EOF -> String
"EOF"