module DDC.Core.Lexer.Names
(
keywords
, readSoConBuiltin
, readKiConBuiltin
, readTwConBuiltin
, readTcConBuiltin
, readWbConBuiltin
, isVarName
, isVarStart
, isVarBody
, readVar
, isConName
, isConStart
, isConBody
, readCon
, isOpName
, isOpStart
, isOpBody
, isLitName
, isLitStart
, isLitBody)
where
import DDC.Core.Exp
import DDC.Core.Lexer.Tokens
import DDC.Data.ListUtils
import Data.Char
import Data.List
keywords :: [(String, Tok n)]
keywords
= [ ("module", KA KModule)
, ("import", KA KImport)
, ("export", KA KExport)
, ("foreign", KA KForeign)
, ("type", KA KType)
, ("value", KA KValue)
, ("data", KA KData)
, ("in", KA KIn)
, ("of", KA KOf)
, ("letrec", KA KLetRec)
, ("letcase", KA KLetCase)
, ("private", KA KPrivate)
, ("extend", KA KExtend)
, ("using", KA KUsing)
, ("withregion", KA KWithRegion)
, ("let", KA KLet)
, ("case", KA KCase)
, ("purify", KA KPurify)
, ("forget", KA KForget)
, ("box", KA KBox)
, ("run", KA KRun)
, ("weakeff", KA KWeakEff)
, ("weakclo", KA KWeakClo)
, ("with", KA KWith)
, ("where", KA KWhere)
, ("do", KA KDo)
, ("match", KA KMatch)
, ("else", KA KElse) ]
readSoConBuiltin :: String -> Maybe SoCon
readSoConBuiltin ss
= case ss of
"Prop" -> Just SoConProp
"Comp" -> Just SoConComp
_ -> Nothing
readKiConBuiltin :: String -> Maybe KiCon
readKiConBuiltin ss
= case ss of
"Witness" -> Just KiConWitness
"Data" -> Just KiConData
"Region" -> Just KiConRegion
"Effect" -> Just KiConEffect
"Closure" -> Just KiConClosure
_ -> Nothing
readTwConBuiltin :: String -> Maybe TwCon
readTwConBuiltin ss
= case ss of
"Global" -> Just TwConGlobal
"DeepGlobal" -> Just TwConDeepGlobal
"Const" -> Just TwConConst
"DeepConst" -> Just TwConDeepConst
"Mutable" -> Just TwConMutable
"DeepMutable" -> Just TwConDeepMutable
"Lazy" -> Just TwConLazy
"HeadLazy" -> Just TwConHeadLazy
"Manifest" -> Just TwConManifest
"Purify" -> Just TwConPure
"Emptify" -> Just TwConEmpty
"Disjoint" -> Just TwConDisjoint
"Distinct" -> Just (TwConDistinct 2)
_ -> readTwConWithArity ss
readTwConWithArity :: String -> Maybe TwCon
readTwConWithArity ss
| Just n <- stripPrefix "Distinct" ss
, all isDigit n
= Just (TwConDistinct $ read n)
| otherwise = Nothing
readTcConBuiltin :: String -> Maybe TcCon
readTcConBuiltin ss
= case ss of
"Unit" -> Just TcConUnit
"S" -> Just TcConSusp
"Read" -> Just TcConRead
"HeadRead" -> Just TcConHeadRead
"DeepRead" -> Just TcConDeepRead
"Write" -> Just TcConWrite
"DeepWrite" -> Just TcConDeepWrite
"Alloc" -> Just TcConAlloc
"DeepAlloc" -> Just TcConDeepAlloc
"Use" -> Just TcConUse
"DeepUse" -> Just TcConDeepUse
_ -> Nothing
readWbConBuiltin :: String -> Maybe WbCon
readWbConBuiltin ss
= case ss of
"pure" -> Just WbConPure
"empty" -> Just WbConEmpty
"use" -> Just WbConUse
"read" -> Just WbConRead
"alloc" -> Just WbConAlloc
_ -> Nothing
isVarName :: String -> Bool
isVarName str
= case str of
[] -> False
c : cs
| isVarStart c
, and (map isVarBody cs)
-> True
| _ : _ <- cs
, Just initCs <- takeInit cs
, isVarStart c
, and (map isVarBody initCs)
, last cs == '#'
-> True
| otherwise
-> False
isVarStart :: Char -> Bool
isVarStart c
= isLower c
|| c == '?'
isVarBody :: Char -> Bool
isVarBody c
= isUpper c
|| isLower c
|| isDigit c
|| c == '_'
|| c == '\''
|| c == '$'
readVar :: String -> Maybe String
readVar ss
| isVarName ss = Just ss
| otherwise = Nothing
isConName :: String -> Bool
isConName str
= case str of
[] -> False
c : cs
| isConStart c
, and (map isConBody cs)
-> True
| _ : _ <- cs
, Just initCs <- takeInit cs
, isConStart c
, and (map isConBody initCs)
, last cs == '#'
-> True
| otherwise
-> False
isConStart :: Char -> Bool
isConStart = isUpper
isConBody :: Char -> Bool
isConBody c
= isUpper c
|| isLower c
|| isDigit c
|| c == '_'
readCon :: String -> Maybe String
readCon ss
| isConName ss = Just ss
| otherwise = Nothing
isOpName :: String -> Bool
isOpName str
= case str of
[] -> False
c : cs
| isOpStart c
, and (map isOpBody cs)
-> True
| otherwise
-> False
isOpStart :: Char -> Bool
isOpStart c
= c == '~' || c == '!' || c == '@' || c == '#'
|| c == '$' || c == '%' || c == '&'
|| c == '*' || c == '-' || c == '+' || c == '='
|| c == ':' || c == '/' || c == '|'
|| c == '<' || c == '>'
isOpBody :: Char -> Bool
isOpBody c
= c == '~' || c == '!' || c == '@' || c == '#'
|| c == '$' || c == '%' || c == '^' || c == '&'
|| c == '*' || c == '-' || c == '+' || c == '='
|| c == ':' || c == '?' || c == '/' || c == '|'
|| c == '<' || c == '>'
isLitName :: String -> Bool
isLitName str
= case str of
[] -> False
c : cs
| isLitStart c
, and (map isLitBody cs)
-> True
| otherwise
-> False
isLitStart :: Char -> Bool
isLitStart c
= isDigit c
|| c == '-'
isLitBody :: Char -> Bool
isLitBody c
= isDigit c
|| c == 'b' || c == 'o' || c == 'x'
|| c == 'w' || c == 'f' || c == 'i'
|| c == '.'
|| c == '#'
|| c == '\''