module DDC.Core.Parser.Tokens
( Tok (..)
, describeTok
, renameTok
, TokAtom (..)
, describeTokAtom
, TokNamed (..)
, describeTokNamed)
where
import DDC.Core.Pretty
import DDC.Core.Exp
data TokenFamily
= Symbol
| Keyword
| Constructor
| Index
| Variable
describeTokenFamily :: TokenFamily -> String
describeTokenFamily tf
= case tf of
Symbol -> "symbol"
Keyword -> "keyword"
Constructor -> "constructor"
Index -> "index"
Variable -> "variable"
data Tok n
= KJunk Char
| KA !TokAtom
| KN !(TokNamed n)
deriving (Eq, Show)
describeTok :: Pretty n => Tok n -> String
describeTok kk
= case kk of
KJunk c -> "character " ++ show c
KA ta -> describeTokAtom ta
KN tn -> describeTokNamed tn
renameTok
:: Ord n2
=> (n1 -> n2) -> Tok n1 -> Tok n2
renameTok f kk
= case kk of
KJunk s -> KJunk s
KA t -> KA t
KN t -> KN $ renameTokNamed f t
data TokAtom
= KRoundBra
| KRoundKet
| KSquareBra
| KSquareKet
| KBraceBra
| KBraceKet
| KAngleBra
| KAngleKet
| KSquareColonBra
| KSquareColonKet
| KAngleColonBra
| KAngleColonKet
| KDot
| KBar
| KHat
| KPlus
| KColon
| KComma
| KBackSlash
| KSemiColon
| KUnderscore
| KEquals
| KAmpersand
| KDash
| KColonColon
| KBigLambda
| KSortComp
| KSortProp
| KKindValue
| KKindRegion
| KKindEffect
| KKindClosure
| KKindWitness
| KArrowTilde
| KArrowDash
| KArrowEquals
| KBotEffect
| KBotClosure
| KWith
| KWhere
| KIn
| KLet
| KLazy
| KLetRec
| KLetRegion
| KWithRegion
| KCase
| KOf
| KWeakEff
| KWeakClo
| KPurify
| KForget
| KIndex Int
| KTwConBuiltin TwCon
| KWbConBuiltin WbCon
| KTcConBuiltin TcCon
deriving (Eq, Show)
describeTokAtom :: TokAtom -> String
describeTokAtom ta
= let (family, str) = describeTokAtom' ta
in describeTokenFamily family ++ " " ++ show str
describeTokAtom' :: TokAtom -> (TokenFamily, String)
describeTokAtom' ta
= case ta of
KRoundBra -> (Symbol, "(")
KRoundKet -> (Symbol, ")")
KSquareBra -> (Symbol, "[")
KSquareKet -> (Symbol, "]")
KBraceBra -> (Symbol, "{")
KBraceKet -> (Symbol, "}")
KAngleBra -> (Symbol, "<")
KAngleKet -> (Symbol, ">")
KSquareColonBra -> (Symbol, "[:")
KSquareColonKet -> (Symbol, ":]")
KAngleColonBra -> (Symbol, "<:")
KAngleColonKet -> (Symbol, ":>")
KDot -> (Symbol, ".")
KBar -> (Symbol, "|")
KHat -> (Symbol, "^")
KPlus -> (Symbol, "+")
KColon -> (Symbol, ":")
KComma -> (Symbol, ",")
KBackSlash -> (Symbol, "\\")
KSemiColon -> (Symbol, ";")
KUnderscore -> (Symbol, "_")
KEquals -> (Symbol, "=")
KAmpersand -> (Symbol, "&")
KDash -> (Symbol, "-")
KColonColon -> (Symbol, "::")
KBigLambda -> (Symbol, "/\\")
KSortComp -> (Constructor, "**")
KSortProp -> (Constructor, "@@")
KKindValue -> (Constructor, "*")
KKindRegion -> (Constructor, "%")
KKindEffect -> (Constructor, "!")
KKindClosure -> (Constructor, "$")
KKindWitness -> (Constructor, "@")
KArrowTilde -> (Constructor, "~>")
KArrowDash -> (Constructor, "->")
KArrowEquals -> (Constructor, "=>")
KBotEffect -> (Constructor, "!0")
KBotClosure -> (Constructor, "!$")
KWith -> (Keyword, "with")
KWhere -> (Keyword, "where")
KIn -> (Keyword, "in")
KLet -> (Keyword, "let")
KLazy -> (Keyword, "lazy")
KLetRec -> (Keyword, "letrec")
KLetRegion -> (Keyword, "letregion")
KWithRegion -> (Keyword, "withregion")
KCase -> (Keyword, "case")
KOf -> (Keyword, "of")
KWeakEff -> (Keyword, "weakeff")
KWeakClo -> (Keyword, "weakclo")
KPurify -> (Keyword, "purify")
KForget -> (Keyword, "forget")
KIndex i -> (Index, "^" ++ show i)
KTwConBuiltin tw -> (Constructor, renderPlain $ ppr tw)
KWbConBuiltin wi -> (Constructor, renderPlain $ ppr wi)
KTcConBuiltin tc -> (Constructor, renderPlain $ ppr tc)
data TokNamed n
= KCon n
| KVar n
| KLit n
deriving (Eq, Show)
describeTokNamed :: Pretty n => TokNamed n -> String
describeTokNamed tn
= case tn of
KCon n -> renderPlain $ text "constructor" <+> (dquotes $ ppr n)
KVar n -> renderPlain $ text "variable" <+> (dquotes $ ppr n)
KLit n -> renderPlain $ text "literal" <+> (dquotes $ ppr n)
renameTokNamed
:: Ord n2
=> (n1 -> n2) -> TokNamed n1 -> TokNamed n2
renameTokNamed f kk
= case kk of
KCon c -> KCon $ f c
KVar c -> KVar $ f c
KLit c -> KLit $ f c