{-# LANGUAGE NamedFieldPuns #-}

-- | Sslang source code tokens.
module Front.Token where

import Common.Identifiers
import Common.Pretty


-- | Tokens extracted from source text.
newtype Token = Token (Span, TokenType)
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
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, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
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)


-- | Extract the 'TokenType' from a 'Token'.
tokenType :: Token -> TokenType
tokenType :: Token -> TokenType
tokenType (Token (Span
_, TokenType
t)) = TokenType
t


-- | The location of a token in the source text.
data Span = Span
  { Span -> Int
tokPos :: Int
  , Span -> Int
tokLen :: Int
  , Span -> Int
tokLine :: Int
  , Span -> Int
tokCol :: Int
  }
  deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Eq, Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show)


-- | The types of tokens that can appear in a sslang source file.
data TokenType
  = TEOF
  | TType
  | TIf
  | TElse
  | TWhile
  | TDo
  | TPar
  | TLoop
  | TLet
  | TNow
  | TAtAt
  | TBreak
  | TMatch
  | TAfter
  | TWait
  | TFun
  | TExtern
  | TEq
  | TLarrow
  | TRarrow
  | TDRarrow
  | TDBar
  | TColon
  | TSemicolon
  | TBar
  | TComma
  | TUnderscore
  | TAt
  | TAmpersand
  | TLparen
  | TRparen
  | TLbrace
  | TRbrace
  | TLbracket
  | TRbracket
  | TInteger Integer
  | TString String
  | TId Identifier
  | TOp Identifier
  | TCSym Identifier
  | TCQuote String
  | TCBlock String
  deriving (TokenType -> TokenType -> Bool
(TokenType -> TokenType -> Bool)
-> (TokenType -> TokenType -> Bool) -> Eq TokenType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenType -> TokenType -> Bool
$c/= :: TokenType -> TokenType -> Bool
== :: TokenType -> TokenType -> Bool
$c== :: TokenType -> TokenType -> Bool
Eq, Int -> TokenType -> ShowS
[TokenType] -> ShowS
TokenType -> String
(Int -> TokenType -> ShowS)
-> (TokenType -> String)
-> ([TokenType] -> ShowS)
-> Show TokenType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenType] -> ShowS
$cshowList :: [TokenType] -> ShowS
show :: TokenType -> String
$cshow :: TokenType -> String
showsPrec :: Int -> TokenType -> ShowS
$cshowsPrec :: Int -> TokenType -> ShowS
Show)


{- | 'Pretty' instance for 'Token', good for dumping tokens for inspection.

Prints 'TokenType' via both its 'Pretty' and 'Show' instances for clarity.
-}
instance Pretty Token where
  pretty :: Token -> Doc ann
pretty (Token (Span
sp, TokenType
tok)) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fill Int
15 (Span -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Span
sp)
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fill Int
31 (TokenType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TokenType
tok)
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"("
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TokenType -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow TokenType
tok
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
")"


-- | 'Pretty' instance for 'Span'. Reports both line:col and [addr+len].
instance Pretty Span where
  pretty :: Span -> Doc ann
pretty Span{Int
tokPos :: Int
tokPos :: Span -> Int
tokPos, Int
tokLen :: Int
tokLen :: Span -> Int
tokLen, Int
tokLine :: Int
tokLine :: Span -> Int
tokLine, Int
tokCol :: Int
tokCol :: Span -> Int
tokCol} =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fill Int
8 (Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
tokLine Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
tokCol)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fill
        Int
8
        (String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
tokPos Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
tokLen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]")


-- | 'Pretty' instance for 'TokenType'. Recovers strings from keywords.
instance Pretty TokenType where
  pretty :: TokenType -> Doc ann
pretty TokenType
TEOF = Doc ann
forall a. Monoid a => a
mempty
  pretty TokenType
TType = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"type"
  pretty TokenType
TIf = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"if"
  pretty TokenType
TElse = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"else"
  pretty TokenType
TWhile = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"while"
  pretty TokenType
TDo = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"do"
  pretty TokenType
TPar = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"par"
  pretty TokenType
TLoop = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"loop"
  pretty TokenType
TLet = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"let"
  pretty TokenType
TNow = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"now"
  pretty TokenType
TAtAt = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"@@"
  pretty TokenType
TBreak = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"break"
  pretty TokenType
TMatch = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"match"
  pretty TokenType
TAfter = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"after"
  pretty TokenType
TWait = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"wait"
  pretty TokenType
TFun = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"fun"
  pretty TokenType
TExtern = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"extern"
  pretty TokenType
TEq = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"="
  pretty TokenType
TDRarrow = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"=>"
  pretty TokenType
TLarrow = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"<-"
  pretty TokenType
TRarrow = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->"
  pretty TokenType
TDBar = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"||"
  pretty TokenType
TColon = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":"
  pretty TokenType
TSemicolon = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
";"
  pretty TokenType
TBar = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"|"
  pretty TokenType
TComma = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
","
  pretty TokenType
TUnderscore = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  pretty TokenType
TAt = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"@"
  pretty TokenType
TAmpersand = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"&"
  pretty TokenType
TLparen = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"("
  pretty TokenType
TRparen = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
")"
  pretty TokenType
TLbrace = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"{"
  pretty TokenType
TRbrace = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"}"
  pretty TokenType
TLbracket = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"["
  pretty TokenType
TRbracket = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]"
  pretty (TInteger Integer
i) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i
  pretty (TString String
s) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
  pretty (TId Identifier
i) = Identifier -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identifier
i
  pretty (TOp Identifier
o) = Identifier -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identifier
o
  pretty (TCSym Identifier
s) = Identifier -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identifier -> Doc ann) -> Identifier -> Doc ann
forall a b. (a -> b) -> a -> b
$ String -> Identifier
forall a. IsString a => String -> a
fromString String
"$" Identifier -> Identifier -> Identifier
forall a. Semigroup a => a -> a -> a
<> Identifier
s
  pretty (TCQuote String
s) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. IsString a => String -> a
fromString String
"$$" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. IsString a => String -> a
fromString String
"$$"
  pretty (TCBlock String
b) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. IsString a => String -> a
fromString String
"$$$" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. IsString a => String -> a
fromString String
"$$$"


-- | Pretty print a list of tokens.
prettyTokens :: [Token] -> String
prettyTokens :: [Token] -> String
prettyTokens = [String] -> String
unlines ([String] -> String) -> ([Token] -> [String]) -> [Token] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> String) -> [Token] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (Token -> Doc Any) -> Token -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty)