module GHC.Utils.Lexeme (
isLexCon, isLexVar, isLexId, isLexSym,
isLexConId, isLexConSym, isLexVarId, isLexVarSym,
startsVarSym, startsVarId, startsConSym, startsConId,
okVarOcc, okConOcc, okTcOcc,
okVarIdOcc, okVarSymOcc, okConIdOcc, okConSymOcc
) where
import GHC.Prelude
import GHC.Data.FastString
import Data.Char
import qualified Data.Set as Set
import GHC.Lexeme
isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
isLexCon :: FastString -> Bool
isLexCon FastString
cs = FastString -> Bool
isLexConId FastString
cs Bool -> Bool -> Bool
|| FastString -> Bool
isLexConSym FastString
cs
isLexVar :: FastString -> Bool
isLexVar FastString
cs = FastString -> Bool
isLexVarId FastString
cs Bool -> Bool -> Bool
|| FastString -> Bool
isLexVarSym FastString
cs
isLexId :: FastString -> Bool
isLexId FastString
cs = FastString -> Bool
isLexConId FastString
cs Bool -> Bool -> Bool
|| FastString -> Bool
isLexVarId FastString
cs
isLexSym :: FastString -> Bool
isLexSym FastString
cs = FastString -> Bool
isLexConSym FastString
cs Bool -> Bool -> Bool
|| FastString -> Bool
isLexVarSym FastString
cs
isLexConId :: FastString -> Bool
isLexConId FastString
cs = case FastString -> String
unpackFS FastString
cs of
[] -> Bool
False
Char
c:String
_ -> FastString
cs FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"[]" Bool -> Bool -> Bool
|| Char -> Bool
startsConId Char
c
isLexVarId :: FastString -> Bool
isLexVarId FastString
cs = case FastString -> String
unpackFS FastString
cs of
[] -> Bool
False
Char
c:String
_ -> Char -> Bool
startsVarId Char
c
isLexConSym :: FastString -> Bool
isLexConSym FastString
cs = case FastString -> String
unpackFS FastString
cs of
[] -> Bool
False
Char
c:String
_ -> FastString
cs FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"->" Bool -> Bool -> Bool
|| Char -> Bool
startsConSym Char
c
isLexVarSym :: FastString -> Bool
isLexVarSym FastString
fs
| FastString
fs FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> FastString
fsLit String
"~R#") = Bool
True
| Bool
otherwise
= case (if FastString -> Bool
nullFS FastString
fs then [] else FastString -> String
unpackFS FastString
fs) of
[] -> Bool
False
(Char
c:String
cs) -> Char -> Bool
startsVarSym Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isVarSymChar String
cs
okVarOcc :: String -> Bool
okVarOcc :: String -> Bool
okVarOcc str :: String
str@(Char
c:String
_)
| Char -> Bool
startsVarId Char
c
= String -> Bool
okVarIdOcc String
str
| Char -> Bool
startsVarSym Char
c
= String -> Bool
okVarSymOcc String
str
okVarOcc String
_ = Bool
False
okConOcc :: String -> Bool
okConOcc :: String -> Bool
okConOcc str :: String
str@(Char
c:String
_)
| Char -> Bool
startsConId Char
c
= String -> Bool
okConIdOcc String
str
| Char -> Bool
startsConSym Char
c
= String -> Bool
okConSymOcc String
str
| String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"[]"
= Bool
True
okConOcc String
_ = Bool
False
okTcOcc :: String -> Bool
okTcOcc :: String -> Bool
okTcOcc String
"[]" = Bool
True
okTcOcc String
"->" = Bool
True
okTcOcc String
"~" = Bool
True
okTcOcc str :: String
str@(Char
c:String
_)
| Char -> Bool
startsConId Char
c
= String -> Bool
okConIdOcc String
str
| Char -> Bool
startsConSym Char
c
= String -> Bool
okConSymOcc String
str
| Char -> Bool
startsVarSym Char
c
= String -> Bool
okVarSymOcc String
str
okTcOcc String
_ = Bool
False
okVarIdOcc :: String -> Bool
okVarIdOcc :: String -> Bool
okVarIdOcc String
str = String -> Bool
okIdOcc String
str Bool -> Bool -> Bool
&&
(String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_" Bool -> Bool -> Bool
|| Bool -> Bool
not (String
str String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
reservedIds))
okVarSymOcc :: String -> Bool
okVarSymOcc :: String -> Bool
okVarSymOcc String
str = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
okSymChar String
str Bool -> Bool -> Bool
&&
Bool -> Bool
not (String
str String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
reservedOps) Bool -> Bool -> Bool
&&
Bool -> Bool
not (String -> Bool
isDashes String
str)
okConIdOcc :: String -> Bool
okConIdOcc :: String -> Bool
okConIdOcc String
str = String -> Bool
okIdOcc String
str Bool -> Bool -> Bool
||
Bool -> String -> Bool
is_tuple_name1 Bool
True String
str Bool -> Bool -> Bool
||
Bool -> String -> Bool
is_tuple_name1 Bool
False String
str Bool -> Bool -> Bool
||
String -> Bool
is_sum_name1 String
str
where
is_tuple_name1 :: Bool -> String -> Bool
is_tuple_name1 Bool
True (Char
'(' : String
rest) = Bool -> String -> Bool
is_tuple_name2 Bool
True String
rest
is_tuple_name1 Bool
False (Char
'(' : Char
'#' : String
rest) = Bool -> String -> Bool
is_tuple_name2 Bool
False String
rest
is_tuple_name1 Bool
_ String
_ = Bool
False
is_tuple_name2 :: Bool -> String -> Bool
is_tuple_name2 Bool
True String
")" = Bool
True
is_tuple_name2 Bool
False String
"#)" = Bool
True
is_tuple_name2 Bool
boxed (Char
',' : String
rest) = Bool -> String -> Bool
is_tuple_name2 Bool
boxed String
rest
is_tuple_name2 Bool
boxed (Char
ws : String
rest)
| Char -> Bool
isSpace Char
ws = Bool -> String -> Bool
is_tuple_name2 Bool
boxed String
rest
is_tuple_name2 Bool
_ String
_ = Bool
False
is_sum_name1 :: String -> Bool
is_sum_name1 (Char
'(' : Char
'#' : String
rest) = Bool -> String -> Bool
is_sum_name2 Bool
False String
rest
is_sum_name1 String
_ = Bool
False
is_sum_name2 :: Bool -> String -> Bool
is_sum_name2 Bool
_ String
"#)" = Bool
True
is_sum_name2 Bool
underscore (Char
'|' : String
rest) = Bool -> String -> Bool
is_sum_name2 Bool
underscore String
rest
is_sum_name2 Bool
False (Char
'_' : String
rest) = Bool -> String -> Bool
is_sum_name2 Bool
True String
rest
is_sum_name2 Bool
underscore (Char
ws : String
rest)
| Char -> Bool
isSpace Char
ws = Bool -> String -> Bool
is_sum_name2 Bool
underscore String
rest
is_sum_name2 Bool
_ String
_ = Bool
False
okConSymOcc :: String -> Bool
okConSymOcc :: String -> Bool
okConSymOcc String
":" = Bool
True
okConSymOcc String
str = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
okSymChar String
str Bool -> Bool -> Bool
&&
Bool -> Bool
not (String
str String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
reservedOps)
okIdOcc :: String -> Bool
okIdOcc :: String -> Bool
okIdOcc String
str
= let hashes :: String
hashes = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
okIdChar String
str in
(Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') String
hashes
okIdChar :: Char -> Bool
okIdChar :: Char -> Bool
okIdChar Char
c = case Char -> GeneralCategory
generalCategory Char
c of
GeneralCategory
UppercaseLetter -> Bool
True
GeneralCategory
LowercaseLetter -> Bool
True
GeneralCategory
TitlecaseLetter -> Bool
True
GeneralCategory
ModifierLetter -> Bool
True
GeneralCategory
OtherLetter -> Bool
True
GeneralCategory
NonSpacingMark -> Bool
True
GeneralCategory
DecimalNumber -> Bool
True
GeneralCategory
OtherNumber -> Bool
True
GeneralCategory
_ -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
reservedIds :: Set.Set String
reservedIds :: Set String
reservedIds = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [ String
"case", String
"class", String
"data", String
"default", String
"deriving"
, String
"do", String
"else", String
"forall", String
"foreign", String
"if", String
"import"
, String
"in", String
"infix", String
"infixl", String
"infixr", String
"instance"
, String
"let", String
"module", String
"newtype", String
"of", String
"then", String
"type"
, String
"where", String
"_" ]
reservedOps :: Set.Set String
reservedOps :: Set String
reservedOps = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [ String
"..", String
":", String
"::", String
"=", String
"\\", String
"|", String
"<-", String
"->"
, String
"=>" ]
isDashes :: String -> Bool
isDashes :: String -> Bool
isDashes (Char
'-' : Char
'-' : String
rest) = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') String
rest
isDashes String
_ = Bool
False