{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Cryptol.Parser.Token where

import Data.Text(Text)
import qualified Data.Text as Text
import Control.DeepSeq
import GHC.Generics

import Cryptol.Utils.PP

data Token    = Token { Token -> TokenT
tokenType :: !TokenT, Token -> Text
tokenText :: !Text }
                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, (forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic, Token -> ()
(Token -> ()) -> NFData Token
forall a. (a -> ()) -> NFData a
rnf :: Token -> ()
$crnf :: Token -> ()
NFData)

-- | Virtual tokens, inserted by layout processing.
data TokenV   = VCurlyL| VCurlyR | VSemi
                deriving (TokenV -> TokenV -> Bool
(TokenV -> TokenV -> Bool)
-> (TokenV -> TokenV -> Bool) -> Eq TokenV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenV -> TokenV -> Bool
$c/= :: TokenV -> TokenV -> Bool
== :: TokenV -> TokenV -> Bool
$c== :: TokenV -> TokenV -> Bool
Eq, Int -> TokenV -> ShowS
[TokenV] -> ShowS
TokenV -> String
(Int -> TokenV -> ShowS)
-> (TokenV -> String) -> ([TokenV] -> ShowS) -> Show TokenV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenV] -> ShowS
$cshowList :: [TokenV] -> ShowS
show :: TokenV -> String
$cshow :: TokenV -> String
showsPrec :: Int -> TokenV -> ShowS
$cshowsPrec :: Int -> TokenV -> ShowS
Show, (forall x. TokenV -> Rep TokenV x)
-> (forall x. Rep TokenV x -> TokenV) -> Generic TokenV
forall x. Rep TokenV x -> TokenV
forall x. TokenV -> Rep TokenV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenV x -> TokenV
$cfrom :: forall x. TokenV -> Rep TokenV x
Generic, TokenV -> ()
(TokenV -> ()) -> NFData TokenV
forall a. (a -> ()) -> NFData a
rnf :: TokenV -> ()
$crnf :: TokenV -> ()
NFData)

data TokenW   = BlockComment | LineComment | Space | DocStr
                deriving (TokenW -> TokenW -> Bool
(TokenW -> TokenW -> Bool)
-> (TokenW -> TokenW -> Bool) -> Eq TokenW
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenW -> TokenW -> Bool
$c/= :: TokenW -> TokenW -> Bool
== :: TokenW -> TokenW -> Bool
$c== :: TokenW -> TokenW -> Bool
Eq, Int -> TokenW -> ShowS
[TokenW] -> ShowS
TokenW -> String
(Int -> TokenW -> ShowS)
-> (TokenW -> String) -> ([TokenW] -> ShowS) -> Show TokenW
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenW] -> ShowS
$cshowList :: [TokenW] -> ShowS
show :: TokenW -> String
$cshow :: TokenW -> String
showsPrec :: Int -> TokenW -> ShowS
$cshowsPrec :: Int -> TokenW -> ShowS
Show, (forall x. TokenW -> Rep TokenW x)
-> (forall x. Rep TokenW x -> TokenW) -> Generic TokenW
forall x. Rep TokenW x -> TokenW
forall x. TokenW -> Rep TokenW x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenW x -> TokenW
$cfrom :: forall x. TokenW -> Rep TokenW x
Generic, TokenW -> ()
(TokenW -> ()) -> NFData TokenW
forall a. (a -> ()) -> NFData a
rnf :: TokenW -> ()
$crnf :: TokenW -> ()
NFData)

data TokenKW  = KW_else
              | KW_extern
              | KW_fin
              | KW_if
              | KW_private
              | KW_include
              | KW_inf
              | KW_lg2
              | KW_lengthFromThen
              | KW_lengthFromThenTo
              | KW_max
              | KW_min
              | KW_module
              | KW_submodule
              | KW_newtype
              | KW_pragma
              | KW_property
              | KW_then
              | KW_type
              | KW_where
              | KW_let
              | KW_x
              | KW_import
              | KW_as
              | KW_hiding
              | KW_infixl
              | KW_infixr
              | KW_infix
              | KW_primitive
              | KW_parameter
              | KW_constraint
              | KW_Prop
              | KW_by
              | KW_down
                deriving (TokenKW -> TokenKW -> Bool
(TokenKW -> TokenKW -> Bool)
-> (TokenKW -> TokenKW -> Bool) -> Eq TokenKW
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenKW -> TokenKW -> Bool
$c/= :: TokenKW -> TokenKW -> Bool
== :: TokenKW -> TokenKW -> Bool
$c== :: TokenKW -> TokenKW -> Bool
Eq, Int -> TokenKW -> ShowS
[TokenKW] -> ShowS
TokenKW -> String
(Int -> TokenKW -> ShowS)
-> (TokenKW -> String) -> ([TokenKW] -> ShowS) -> Show TokenKW
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenKW] -> ShowS
$cshowList :: [TokenKW] -> ShowS
show :: TokenKW -> String
$cshow :: TokenKW -> String
showsPrec :: Int -> TokenKW -> ShowS
$cshowsPrec :: Int -> TokenKW -> ShowS
Show, (forall x. TokenKW -> Rep TokenKW x)
-> (forall x. Rep TokenKW x -> TokenKW) -> Generic TokenKW
forall x. Rep TokenKW x -> TokenKW
forall x. TokenKW -> Rep TokenKW x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenKW x -> TokenKW
$cfrom :: forall x. TokenKW -> Rep TokenKW x
Generic, TokenKW -> ()
(TokenKW -> ()) -> NFData TokenKW
forall a. (a -> ()) -> NFData a
rnf :: TokenKW -> ()
$crnf :: TokenKW -> ()
NFData)

-- | The named operators are a special case for parsing types, and 'Other' is
-- used for all other cases that lexed as an operator.
data TokenOp  = Plus | Minus | Mul | Div | Exp | Mod
              | Equal | LEQ | GEQ
              | Complement | Hash | At
              | Other [Text] Text
                deriving (TokenOp -> TokenOp -> Bool
(TokenOp -> TokenOp -> Bool)
-> (TokenOp -> TokenOp -> Bool) -> Eq TokenOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenOp -> TokenOp -> Bool
$c/= :: TokenOp -> TokenOp -> Bool
== :: TokenOp -> TokenOp -> Bool
$c== :: TokenOp -> TokenOp -> Bool
Eq, Int -> TokenOp -> ShowS
[TokenOp] -> ShowS
TokenOp -> String
(Int -> TokenOp -> ShowS)
-> (TokenOp -> String) -> ([TokenOp] -> ShowS) -> Show TokenOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenOp] -> ShowS
$cshowList :: [TokenOp] -> ShowS
show :: TokenOp -> String
$cshow :: TokenOp -> String
showsPrec :: Int -> TokenOp -> ShowS
$cshowsPrec :: Int -> TokenOp -> ShowS
Show, (forall x. TokenOp -> Rep TokenOp x)
-> (forall x. Rep TokenOp x -> TokenOp) -> Generic TokenOp
forall x. Rep TokenOp x -> TokenOp
forall x. TokenOp -> Rep TokenOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenOp x -> TokenOp
$cfrom :: forall x. TokenOp -> Rep TokenOp x
Generic, TokenOp -> ()
(TokenOp -> ()) -> NFData TokenOp
forall a. (a -> ()) -> NFData a
rnf :: TokenOp -> ()
$crnf :: TokenOp -> ()
NFData)

data TokenSym = Bar
              | ArrL | ArrR | FatArrR
              | Lambda
              | EqDef
              | Comma
              | Semi
              | Dot
              | DotDot
              | DotDotDot
              | DotDotLt
              | DotDotGt
              | Colon
              | BackTick
              | ParenL   | ParenR
              | BracketL | BracketR
              | CurlyL   | CurlyR
              | TriL     | TriR
              | Lt | Gt
              | Underscore
                deriving (TokenSym -> TokenSym -> Bool
(TokenSym -> TokenSym -> Bool)
-> (TokenSym -> TokenSym -> Bool) -> Eq TokenSym
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenSym -> TokenSym -> Bool
$c/= :: TokenSym -> TokenSym -> Bool
== :: TokenSym -> TokenSym -> Bool
$c== :: TokenSym -> TokenSym -> Bool
Eq, Int -> TokenSym -> ShowS
[TokenSym] -> ShowS
TokenSym -> String
(Int -> TokenSym -> ShowS)
-> (TokenSym -> String) -> ([TokenSym] -> ShowS) -> Show TokenSym
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenSym] -> ShowS
$cshowList :: [TokenSym] -> ShowS
show :: TokenSym -> String
$cshow :: TokenSym -> String
showsPrec :: Int -> TokenSym -> ShowS
$cshowsPrec :: Int -> TokenSym -> ShowS
Show, (forall x. TokenSym -> Rep TokenSym x)
-> (forall x. Rep TokenSym x -> TokenSym) -> Generic TokenSym
forall x. Rep TokenSym x -> TokenSym
forall x. TokenSym -> Rep TokenSym x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenSym x -> TokenSym
$cfrom :: forall x. TokenSym -> Rep TokenSym x
Generic, TokenSym -> ()
(TokenSym -> ()) -> NFData TokenSym
forall a. (a -> ()) -> NFData a
rnf :: TokenSym -> ()
$crnf :: TokenSym -> ()
NFData)

data TokenErr = UnterminatedComment
              | UnterminatedString
              | UnterminatedChar
              | InvalidString
              | InvalidChar
              | LexicalError
              | MalformedLiteral
              | MalformedSelector
              | InvalidIndentation TokenT -- expected closing paren
                deriving (TokenErr -> TokenErr -> Bool
(TokenErr -> TokenErr -> Bool)
-> (TokenErr -> TokenErr -> Bool) -> Eq TokenErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenErr -> TokenErr -> Bool
$c/= :: TokenErr -> TokenErr -> Bool
== :: TokenErr -> TokenErr -> Bool
$c== :: TokenErr -> TokenErr -> Bool
Eq, Int -> TokenErr -> ShowS
[TokenErr] -> ShowS
TokenErr -> String
(Int -> TokenErr -> ShowS)
-> (TokenErr -> String) -> ([TokenErr] -> ShowS) -> Show TokenErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenErr] -> ShowS
$cshowList :: [TokenErr] -> ShowS
show :: TokenErr -> String
$cshow :: TokenErr -> String
showsPrec :: Int -> TokenErr -> ShowS
$cshowsPrec :: Int -> TokenErr -> ShowS
Show, (forall x. TokenErr -> Rep TokenErr x)
-> (forall x. Rep TokenErr x -> TokenErr) -> Generic TokenErr
forall x. Rep TokenErr x -> TokenErr
forall x. TokenErr -> Rep TokenErr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenErr x -> TokenErr
$cfrom :: forall x. TokenErr -> Rep TokenErr x
Generic, TokenErr -> ()
(TokenErr -> ()) -> NFData TokenErr
forall a. (a -> ()) -> NFData a
rnf :: TokenErr -> ()
$crnf :: TokenErr -> ()
NFData)

data SelectorType = RecordSelectorTok Text | TupleSelectorTok Int
                deriving (SelectorType -> SelectorType -> Bool
(SelectorType -> SelectorType -> Bool)
-> (SelectorType -> SelectorType -> Bool) -> Eq SelectorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorType -> SelectorType -> Bool
$c/= :: SelectorType -> SelectorType -> Bool
== :: SelectorType -> SelectorType -> Bool
$c== :: SelectorType -> SelectorType -> Bool
Eq, Int -> SelectorType -> ShowS
[SelectorType] -> ShowS
SelectorType -> String
(Int -> SelectorType -> ShowS)
-> (SelectorType -> String)
-> ([SelectorType] -> ShowS)
-> Show SelectorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorType] -> ShowS
$cshowList :: [SelectorType] -> ShowS
show :: SelectorType -> String
$cshow :: SelectorType -> String
showsPrec :: Int -> SelectorType -> ShowS
$cshowsPrec :: Int -> SelectorType -> ShowS
Show, (forall x. SelectorType -> Rep SelectorType x)
-> (forall x. Rep SelectorType x -> SelectorType)
-> Generic SelectorType
forall x. Rep SelectorType x -> SelectorType
forall x. SelectorType -> Rep SelectorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectorType x -> SelectorType
$cfrom :: forall x. SelectorType -> Rep SelectorType x
Generic, SelectorType -> ()
(SelectorType -> ()) -> NFData SelectorType
forall a. (a -> ()) -> NFData a
rnf :: SelectorType -> ()
$crnf :: SelectorType -> ()
NFData)

data TokenT   = Num !Integer !Int !Int    -- ^ value, base, number of digits
              | Frac !Rational !Int       -- ^ value, base.
              | ChrLit  !Char             -- ^ character literal
              | Ident ![Text] !Text       -- ^ (qualified) identifier
              | StrLit !String            -- ^ string literal
              | Selector !SelectorType    -- ^ .hello or .123
              | KW    !TokenKW            -- ^ keyword
              | Op    !TokenOp            -- ^ operator
              | Sym   !TokenSym           -- ^ symbol
              | Virt  !TokenV             -- ^ virtual token (for layout)
              | White !TokenW             -- ^ white space token
              | Err   !TokenErr           -- ^ error token
              | EOF
                deriving (TokenT -> TokenT -> Bool
(TokenT -> TokenT -> Bool)
-> (TokenT -> TokenT -> Bool) -> Eq TokenT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenT -> TokenT -> Bool
$c/= :: TokenT -> TokenT -> Bool
== :: TokenT -> TokenT -> Bool
$c== :: TokenT -> TokenT -> Bool
Eq, Int -> TokenT -> ShowS
[TokenT] -> ShowS
TokenT -> String
(Int -> TokenT -> ShowS)
-> (TokenT -> String) -> ([TokenT] -> ShowS) -> Show TokenT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenT] -> ShowS
$cshowList :: [TokenT] -> ShowS
show :: TokenT -> String
$cshow :: TokenT -> String
showsPrec :: Int -> TokenT -> ShowS
$cshowsPrec :: Int -> TokenT -> ShowS
Show, (forall x. TokenT -> Rep TokenT x)
-> (forall x. Rep TokenT x -> TokenT) -> Generic TokenT
forall x. Rep TokenT x -> TokenT
forall x. TokenT -> Rep TokenT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenT x -> TokenT
$cfrom :: forall x. TokenT -> Rep TokenT x
Generic, TokenT -> ()
(TokenT -> ()) -> NFData TokenT
forall a. (a -> ()) -> NFData a
rnf :: TokenT -> ()
$crnf :: TokenT -> ()
NFData)

instance PP Token where
  ppPrec :: Int -> Token -> Doc
ppPrec Int
_ (Token TokenT
_ Text
s) = String -> Doc
text (Text -> String
Text.unpack Text
s)