{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Rzk.VSCode.Tokenize where

import           Data.Char                   (isAlphaNum)
import           Data.List                   (sortOn)
import qualified Data.Text                   as T
import           Language.LSP.Protocol.Types (SemanticTokenAbsolute (..),
                                              SemanticTokenModifiers (..),
                                              SemanticTokenTypes (..))
import           Language.Rzk.Syntax
import           Language.Rzk.Syntax.Lex     (Posn (Pn),
                                              Tok (T_HoleIdentToken, TK),
                                              TokSymbol (TokSymbol),
                                              Token (PT))
import qualified Language.Rzk.Syntax.Lex     as Lex

tokenizeModule :: Module -> [SemanticTokenAbsolute]
tokenizeModule :: Module -> [SemanticTokenAbsolute]
tokenizeModule (Module BNFC'Position
_loc LanguageDecl' BNFC'Position
langDecl [Command' BNFC'Position]
commands) = [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ LanguageDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeLanguageDecl LanguageDecl' BNFC'Position
langDecl
  , Int -> [Command' BNFC'Position] -> [SemanticTokenAbsolute]
tokenizeCommands Int
0 [Command' BNFC'Position]
commands
  ]

-- | Walk the commands tracking the section depth: an assumption outside
-- any section is a file-wide axiom and is marked as an abstract function
-- (see 'tokenizeCommand'), while an assumption inside a section is a
-- hypothesis the section abstracts over at its @#end@, so it keeps the
-- parameter token type and only gains the abstract modifier.
tokenizeCommands :: Int -> [Command] -> [SemanticTokenAbsolute]
tokenizeCommands :: Int -> [Command' BNFC'Position] -> [SemanticTokenAbsolute]
tokenizeCommands Int
_ [] = []
tokenizeCommands Int
depth (Command' BNFC'Position
command : [Command' BNFC'Position]
commands) = case Command' BNFC'Position
command of
  CommandSection{} ->
    Command' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeCommand Command' BNFC'Position
command [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. [a] -> [a] -> [a]
++ Int -> [Command' BNFC'Position] -> [SemanticTokenAbsolute]
tokenizeCommands (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Command' BNFC'Position]
commands
  CommandSectionEnd{} ->
    Command' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeCommand Command' BNFC'Position
command [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. [a] -> [a] -> [a]
++ Int -> [Command' BNFC'Position] -> [SemanticTokenAbsolute]
tokenizeCommands (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [Command' BNFC'Position]
commands
  CommandAssume BNFC'Position
_loc [VarIdent' BNFC'Position]
vars Term' BNFC'Position
type_ | Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (VarIdent' BNFC'Position -> [SemanticTokenAbsolute])
-> [VarIdent' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\VarIdent' BNFC'Position
var -> VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
var SemanticTokenTypes
SemanticTokenTypes_Parameter [SemanticTokenModifiers
SemanticTokenModifiers_Declaration, SemanticTokenModifiers
SemanticTokenModifiers_Abstract]) [VarIdent' BNFC'Position]
vars
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
    ] [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. [a] -> [a] -> [a]
++ Int -> [Command' BNFC'Position] -> [SemanticTokenAbsolute]
tokenizeCommands Int
depth [Command' BNFC'Position]
commands
  Command' BNFC'Position
_ -> Command' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeCommand Command' BNFC'Position
command [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. [a] -> [a] -> [a]
++ Int -> [Command' BNFC'Position] -> [SemanticTokenAbsolute]
tokenizeCommands Int
depth [Command' BNFC'Position]
commands

tokenizeLanguageDecl :: LanguageDecl -> [SemanticTokenAbsolute]
tokenizeLanguageDecl :: LanguageDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeLanguageDecl LanguageDecl' BNFC'Position
_ = []

tokenizeCommand :: Command -> [SemanticTokenAbsolute]
tokenizeCommand :: Command' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeCommand Command' BNFC'Position
command = case Command' BNFC'Position
command of
  CommandSetOption{}   -> []    -- NOTE: fallback to TextMate
  CommandUnsetOption{} -> []    -- NOTE: fallback to TextMate
  CommandCheck        BNFC'Position
_loc Term' BNFC'Position
term Term' BNFC'Position
type_ -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm [Term' BNFC'Position
term, Term' BNFC'Position
type_]
  CommandCompute      BNFC'Position
_loc Term' BNFC'Position
term -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term
  CommandComputeNF    BNFC'Position
_loc Term' BNFC'Position
term -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term
  CommandComputeWHNF  BNFC'Position
_loc Term' BNFC'Position
term -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term

  -- A postulate is declared, but not proven: the abstract modifier lets
  -- clients render its name (here and at every use site, see
  -- 'Language.Rzk.VSCode.Handlers.useSiteTokens') distinctly. The static
  -- modifier distinguishes it from a top-level assumption: a postulate is
  -- a permanent axiom, so clients can style it louder.
  CommandPostulate BNFC'Position
_loc VarIdent' BNFC'Position
name DeclUsedVars' BNFC'Position
declUsedVars [Param' BNFC'Position]
params Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_Declaration, SemanticTokenModifiers
SemanticTokenModifiers_Abstract, SemanticTokenModifiers
SemanticTokenModifiers_Static]
    , DeclUsedVars' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDeclUsedVars DeclUsedVars' BNFC'Position
declUsedVars
    , (Param' BNFC'Position -> [SemanticTokenAbsolute])
-> [Param' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
    ]
  CommandDefine BNFC'Position
_loc VarIdent' BNFC'Position
name DeclUsedVars' BNFC'Position
declUsedVars [Param' BNFC'Position]
params Term' BNFC'Position
type_ Term' BNFC'Position
term -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
    , DeclUsedVars' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDeclUsedVars DeclUsedVars' BNFC'Position
declUsedVars
    , (Param' BNFC'Position -> [SemanticTokenAbsolute])
-> [Param' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
    , (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm [Term' BNFC'Position
type_, Term' BNFC'Position
term]
    ]

  -- A name assumed at the top level is a file-wide axiom like a postulate
  -- (see 'CommandPostulate' above), so it gets the same abstract marking;
  -- 'tokenizeCommands' intercepts the in-section case.
  CommandAssume BNFC'Position
_loc [VarIdent' BNFC'Position]
vars Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (VarIdent' BNFC'Position -> [SemanticTokenAbsolute])
-> [VarIdent' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\VarIdent' BNFC'Position
var -> VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
var SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_Declaration, SemanticTokenModifiers
SemanticTokenModifiers_Abstract]) [VarIdent' BNFC'Position]
vars
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
    ]
  CommandSection    BNFC'Position
_loc SectionName' BNFC'Position
name -> SectionName' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeSectionName SectionName' BNFC'Position
name
  CommandSectionEnd BNFC'Position
_loc SectionName' BNFC'Position
name -> SectionName' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeSectionName SectionName' BNFC'Position
name

  CommandData BNFC'Position
_loc VarIdent' BNFC'Position
name DeclUsedVars' BNFC'Position
declUsedVars [Param' BNFC'Position]
params DataSort' BNFC'Position
sort DataBody' BNFC'Position
body -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
    , DeclUsedVars' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDeclUsedVars DeclUsedVars' BNFC'Position
declUsedVars
    , (Param' BNFC'Position -> [SemanticTokenAbsolute])
-> [Param' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
    , DataSort' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDataSort DataSort' BNFC'Position
sort
    , DataBody' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDataBody DataBody' BNFC'Position
body
    ]

tokenizeDataSort :: DataSort -> [SemanticTokenAbsolute]
tokenizeDataSort :: DataSort' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDataSort = \case
  SomeDataSort BNFC'Position
_loc Term' BNFC'Position
ty -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
ty
  NoDataSort BNFC'Position
_loc      -> []

tokenizeDataBody :: DataBody -> [SemanticTokenAbsolute]
tokenizeDataBody :: DataBody' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDataBody = \case
  NoDataBody BNFC'Position
_loc -> []
  SomeDataBody BNFC'Position
_loc [Constructor' BNFC'Position]
cons [DataElim' BNFC'Position]
elims -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (Constructor' BNFC'Position -> [SemanticTokenAbsolute])
-> [Constructor' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Constructor' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeConstructor [Constructor' BNFC'Position]
cons
    , (DataElim' BNFC'Position -> [SemanticTokenAbsolute])
-> [DataElim' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DataElim' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDataElim [DataElim' BNFC'Position]
elims
    ]

tokenizeConstructor :: Constructor -> [SemanticTokenAbsolute]
tokenizeConstructor :: Constructor' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeConstructor (Constructor BNFC'Position
_loc VarIdent' BNFC'Position
name [Param' BNFC'Position]
params ConstructorType' BNFC'Position
ctype) = [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
  , (Param' BNFC'Position -> [SemanticTokenAbsolute])
-> [Param' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
  , case ConstructorType' BNFC'Position
ctype of
      SomeConstructorType BNFC'Position
_loc' Term' BNFC'Position
ty -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
ty
      NoConstructorType BNFC'Position
_loc'      -> []
  ]

tokenizeDataElim :: DataElim -> [SemanticTokenAbsolute]
tokenizeDataElim :: DataElim' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDataElim = \case
  DataElim BNFC'Position
_loc VarIdent' BNFC'Position
name Term' BNFC'Position
ty    -> VarIdent' BNFC'Position
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
forall {a}.
(HasPosition a, Print a) =>
a -> Term' BNFC'Position -> [SemanticTokenAbsolute]
clause VarIdent' BNFC'Position
name Term' BNFC'Position
ty
  DataCompute BNFC'Position
_loc VarIdent' BNFC'Position
name Term' BNFC'Position
ty -> VarIdent' BNFC'Position
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
forall {a}.
(HasPosition a, Print a) =>
a -> Term' BNFC'Position -> [SemanticTokenAbsolute]
clause VarIdent' BNFC'Position
name Term' BNFC'Position
ty
  where
    clause :: a -> Term' BNFC'Position -> [SemanticTokenAbsolute]
clause a
name Term' BNFC'Position
ty = [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken a
name SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
      , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
ty
      ]

tokenizeDeclUsedVars :: DeclUsedVars -> [SemanticTokenAbsolute]
tokenizeDeclUsedVars :: DeclUsedVars' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeDeclUsedVars (DeclUsedVars BNFC'Position
_loc [VarIdent' BNFC'Position]
vars) =
  (VarIdent' BNFC'Position -> [SemanticTokenAbsolute])
-> [VarIdent' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\VarIdent' BNFC'Position
var -> VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
var SemanticTokenTypes
SemanticTokenTypes_Parameter []) [VarIdent' BNFC'Position]
vars

tokenizeSectionName :: SectionName -> [SemanticTokenAbsolute]
tokenizeSectionName :: SectionName' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeSectionName = \case
  NoSectionName{}       -> []
  SomeSectionName BNFC'Position
_ VarIdent' BNFC'Position
name -> VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_Property []

tokenizeBind :: Bind -> [SemanticTokenAbsolute]
tokenizeBind :: Bind -> [SemanticTokenAbsolute]
tokenizeBind = \case
  BindPattern BNFC'Position
_loc Pattern
pat -> Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
  BindPatternType BNFC'Position
_loc Pattern
pat Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat, Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_]

tokenizeParam :: Param -> [SemanticTokenAbsolute]
tokenizeParam :: Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam = \case
  ParamPattern BNFC'Position
_loc Pattern
pat -> Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
  ParamPatternType BNFC'Position
_loc [Pattern]
pats Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  ParamPatternShape BNFC'Position
_loc [Pattern]
pats Term' BNFC'Position
cube Term' BNFC'Position
tope -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope ]
  ParamPatternModalType BNFC'Position
_loc [Pattern]
pats ModalColon
mc Term' BNFC'Position
ty -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
    , ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
ty ]
  ParamPatternModalShape BNFC'Position
_loc [Pattern]
pats ModalColon
mc Term' BNFC'Position
cube Term' BNFC'Position
tope -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
    , ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope ]

tokenizePattern :: Pattern -> [SemanticTokenAbsolute]
tokenizePattern :: Pattern -> [SemanticTokenAbsolute]
tokenizePattern = \case
  PatternVar BNFC'Position
_loc VarIdent' BNFC'Position
var    -> VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
var SemanticTokenTypes
SemanticTokenTypes_Parameter [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
  PatternPair BNFC'Position
_loc Pattern
l Pattern
r   -> (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern
l, Pattern
r]
  pat :: Pattern
pat@(PatternUnit BNFC'Position
_loc) -> Pattern
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Pattern
pat SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
  PatternTuple BNFC'Position
_loc Pattern
p1 Pattern
p2 [Pattern]
ps -> (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern (Pattern
p1 Pattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
: Pattern
p2 Pattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
: [Pattern]
ps)

-- | A match branch: the constructor name is an enum member (as constructor
-- uses are), the binders are parameters, the body is an ordinary term.
tokenizeMatchBranch :: MatchBranch -> [SemanticTokenAbsolute]
tokenizeMatchBranch :: MatchBranch -> [SemanticTokenAbsolute]
tokenizeMatchBranch (MatchBranch BNFC'Position
_loc VarIdent' BNFC'Position
con [Pattern]
pats Term' BNFC'Position
body) = [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
con SemanticTokenTypes
SemanticTokenTypes_EnumMember []
  , (Pattern -> [SemanticTokenAbsolute])
-> [Pattern] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
  , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
body ]

tokenizeTope :: Term -> [SemanticTokenAbsolute]
tokenizeTope :: Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope = Maybe SemanticTokenTypes
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm' (SemanticTokenTypes -> Maybe SemanticTokenTypes
forall a. a -> Maybe a
Just SemanticTokenTypes
SemanticTokenTypes_String)

tokenizeTerm :: Term -> [SemanticTokenAbsolute]
tokenizeTerm :: Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm = Maybe SemanticTokenTypes
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm' Maybe SemanticTokenTypes
forall a. Maybe a
Nothing

tokenizeTerm' :: Maybe SemanticTokenTypes -> Term -> [SemanticTokenAbsolute]
tokenizeTerm' :: Maybe SemanticTokenTypes
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm' Maybe SemanticTokenTypes
varTokenType = Term' BNFC'Position -> [SemanticTokenAbsolute]
go
  where
    go :: Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
term = case Term' BNFC'Position
term of
      Hole{} -> [] -- highlighted from the token stream ('tokenizeSyntaxSymbols')
      Var{} -> case Maybe SemanticTokenTypes
varTokenType of
                 Maybe SemanticTokenTypes
Nothing         -> []
                 Just SemanticTokenTypes
token_type -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
token_type []

      Universe{}           -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      UniverseCube{}       -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      UniverseTope{}       -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      CubeUnit{}           -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      CubeUnitStar{}       -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_CubeUnitStar{} -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      Cube2{}              -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      Cube2_0{}            -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_Cube2_0{}      -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      Cube2_1{}            -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_Cube2_1{}      -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      CubeI{}              -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      CubeI_0{}            -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_CubeI_0{}      -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      CubeI_1{}            -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_CubeI_1{}      -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_CubeI{}        -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      CubeProduct BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
l, Term' BNFC'Position
r]
      CubeSup BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
l, Term' BNFC'Position
r]
      CubeInf BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
l, Term' BNFC'Position
r]

      TopeTop{}            -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_TopeTop{}            -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      TopeBottom{}         -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_TopeBottom{}         -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      TopeAnd BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeAnd BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeOr  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeOr  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeEQ  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeEQ  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeLEQ BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeLEQ BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeInv BNFC'Position
_loc Term' BNFC'Position
t       -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
t]
      TopeUninv BNFC'Position
_loc Term' BNFC'Position
t     -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
t]
      CubeFlip BNFC'Position
_loc Term' BNFC'Position
c      -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
c]
      CubeUnflip BNFC'Position
_loc Term' BNFC'Position
c    -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
c]

      RecBottom{}          -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      RecOr BNFC'Position
_loc [Restriction' BNFC'Position]
rs -> (Restriction' BNFC'Position -> [SemanticTokenAbsolute])
-> [Restriction' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Restriction' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeRestriction [Restriction' BNFC'Position]
rs

      TypeFun BNFC'Position
_loc ParamDecl' BNFC'Position
paramDecl Term' BNFC'Position
ret -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ ParamDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParamDecl ParamDecl' BNFC'Position
paramDecl
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
ret ]
      ASCII_TypeFun BNFC'Position
_loc ParamDecl' BNFC'Position
paramDecl Term' BNFC'Position
ret -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ ParamDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParamDecl ParamDecl' BNFC'Position
paramDecl
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
ret ]
      TypeSigma BNFC'Position
loc Pattern
pat Term' BNFC'Position
a Term' BNFC'Position
b -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"∑") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
        , (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b] ]
      TypeSigmaModal BNFC'Position
loc Pattern
pat ModalColon
mc Term' BNFC'Position
a Term' BNFC'Position
b -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"∑") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
        , ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc
        , (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b] ]
      ASCII_TypeSigma BNFC'Position
loc Pattern
pat Term' BNFC'Position
a Term' BNFC'Position
b -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"Sigma") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
        , (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b] ]
      TypeSigmaTuple BNFC'Position
loc SigmaParam' BNFC'Position
p [SigmaParam' BNFC'Position]
ps Term' BNFC'Position
tN -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"∑") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , (SigmaParam' BNFC'Position -> [SemanticTokenAbsolute])
-> [SigmaParam' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SigmaParam' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeSigmaParam (SigmaParam' BNFC'Position
p SigmaParam' BNFC'Position
-> [SigmaParam' BNFC'Position] -> [SigmaParam' BNFC'Position]
forall a. a -> [a] -> [a]
: [SigmaParam' BNFC'Position]
ps)
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
tN ]
      ASCII_TypeSigmaTuple BNFC'Position
loc SigmaParam' BNFC'Position
p [SigmaParam' BNFC'Position]
ps Term' BNFC'Position
tN -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"Sigma") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , (SigmaParam' BNFC'Position -> [SemanticTokenAbsolute])
-> [SigmaParam' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SigmaParam' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeSigmaParam (SigmaParam' BNFC'Position
p SigmaParam' BNFC'Position
-> [SigmaParam' BNFC'Position] -> [SigmaParam' BNFC'Position]
forall a. a -> [a] -> [a]
: [SigmaParam' BNFC'Position]
ps)
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
tN ]
      TypeId BNFC'Position
_loc Term' BNFC'Position
x Term' BNFC'Position
a Term' BNFC'Position
y -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
x, Term' BNFC'Position
a, Term' BNFC'Position
y]
      TypeIdSimple BNFC'Position
_loc Term' BNFC'Position
x Term' BNFC'Position
y -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
x, Term' BNFC'Position
y]
      TypeRestricted BNFC'Position
_loc Term' BNFC'Position
type_ [Restriction' BNFC'Position]
rs -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
type_
        , (Restriction' BNFC'Position -> [SemanticTokenAbsolute])
-> [Restriction' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Restriction' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeRestriction [Restriction' BNFC'Position]
rs ]

      App BNFC'Position
_loc Term' BNFC'Position
f Term' BNFC'Position
x -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
f, Term' BNFC'Position
x]
      Lambda BNFC'Position
_loc [Param' BNFC'Position]
params Term' BNFC'Position
body -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ (Param' BNFC'Position -> [SemanticTokenAbsolute])
-> [Param' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
body ]
      Let BNFC'Position
_loc Bind
bind Term' BNFC'Position
val Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      LetModBind BNFC'Position
_loc Modality
md Bind
bind Term' BNFC'Position
val Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
md, Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      LetMod BNFC'Position
_loc Modality
inn Bind
bind Term' BNFC'Position
val Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
inn, Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      LetModFramed BNFC'Position
_loc Modality
ext Modality
inn Bind
bind Term' BNFC'Position
val Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
ext, Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
inn, Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      LetModBindInto BNFC'Position
_loc Modality
md Bind
bind Term' BNFC'Position
val Term' BNFC'Position
motive Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
md, Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
motive, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      LetModInto BNFC'Position
_loc Modality
inn Bind
bind Term' BNFC'Position
val Term' BNFC'Position
motive Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
inn, Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
motive, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      LetModFramedInto BNFC'Position
_loc Modality
ext Modality
inn Bind
bind Term' BNFC'Position
val Term' BNFC'Position
motive Term' BNFC'Position
expr -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
ext, Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
inn, Bind -> [SemanticTokenAbsolute]
tokenizeBind Bind
bind, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
val, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
motive, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
expr]
      ASCII_Lambda BNFC'Position
loc [Param' BNFC'Position]
params Term' BNFC'Position
body -> Term' BNFC'Position -> [SemanticTokenAbsolute]
go (BNFC'Position
-> [Param' BNFC'Position]
-> Term' BNFC'Position
-> Term' BNFC'Position
forall a. a -> [Param' a] -> Term' a -> Term' a
Lambda BNFC'Position
loc [Param' BNFC'Position]
params Term' BNFC'Position
body)

      Pair BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
l, Term' BNFC'Position
r]
      Tuple BNFC'Position
_loc Term' BNFC'Position
p1 Term' BNFC'Position
p2 [Term' BNFC'Position]
ps -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go (Term' BNFC'Position
p1Term' BNFC'Position
-> [Term' BNFC'Position] -> [Term' BNFC'Position]
forall a. a -> [a] -> [a]
:Term' BNFC'Position
p2Term' BNFC'Position
-> [Term' BNFC'Position] -> [Term' BNFC'Position]
forall a. a -> [a] -> [a]
:[Term' BNFC'Position]
ps)
      First BNFC'Position
loc Term' BNFC'Position
t -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"π₁") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]
      ASCII_First BNFC'Position
loc Term' BNFC'Position
t -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"first") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]
      Second BNFC'Position
loc Term' BNFC'Position
t -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"π₂") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]
      ASCII_Second BNFC'Position
loc Term' BNFC'Position
t -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"second") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]

      TypeUnit BNFC'Position
_loc -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      Unit BNFC'Position
_loc -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      Refl{} -> Term' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ReflTerm BNFC'Position
loc Term' BNFC'Position
x -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"refl") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
x ]
      ReflTermType BNFC'Position
loc Term' BNFC'Position
x Term' BNFC'Position
a -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"refl") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
x, Term' BNFC'Position
a] ]

      IdJ BNFC'Position
loc Term' BNFC'Position
a Term' BNFC'Position
b Term' BNFC'Position
c Term' BNFC'Position
d Term' BNFC'Position
e Term' BNFC'Position
f -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ VarIdent' BNFC'Position
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (BNFC'Position -> VarIdentToken -> VarIdent' BNFC'Position
forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"J") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b, Term' BNFC'Position
c, Term' BNFC'Position
d, Term' BNFC'Position
e, Term' BNFC'Position
f] ]

      TypeAsc BNFC'Position
_loc Term' BNFC'Position
t Term' BNFC'Position
type_ -> (Term' BNFC'Position -> [SemanticTokenAbsolute])
-> [Term' BNFC'Position] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
t, Term' BNFC'Position
type_]

      Match BNFC'Position
_loc Term' BNFC'Position
scrut [MatchBranch]
branches -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
scrut
        , (MatchBranch -> [SemanticTokenAbsolute])
-> [MatchBranch] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap MatchBranch -> [SemanticTokenAbsolute]
tokenizeMatchBranch [MatchBranch]
branches ]
      MatchInto BNFC'Position
_loc Term' BNFC'Position
scrut Term' BNFC'Position
motive [MatchBranch]
branches -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
scrut
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
motive
        , (MatchBranch -> [SemanticTokenAbsolute])
-> [MatchBranch] -> [SemanticTokenAbsolute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap MatchBranch -> [SemanticTokenAbsolute]
tokenizeMatchBranch [MatchBranch]
branches ]

      ModType BNFC'Position
_loc Modality
md Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
md, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
type_]
      ModApp BNFC'Position
_loc Modality
md Term' BNFC'Position
te -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
md, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
te]
      ModExtract BNFC'Position
_loc ModComp' BNFC'Position
comp Term' BNFC'Position
te -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ModComp' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeModComp ModComp' BNFC'Position
comp, Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
te]


tokenizeRestriction :: Restriction -> [SemanticTokenAbsolute]
tokenizeRestriction :: Restriction' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeRestriction (Restriction BNFC'Position
_loc Term' BNFC'Position
tope Term' BNFC'Position
term) = [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
  , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term ]
tokenizeRestriction (ASCII_Restriction BNFC'Position
_loc Term' BNFC'Position
tope Term' BNFC'Position
term) = [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
  , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term ]

tokenizeParamDecl :: ParamDecl -> [SemanticTokenAbsolute]
tokenizeParamDecl :: ParamDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParamDecl = \case
  ParamType BNFC'Position
_loc Term' BNFC'Position
type_ -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
  ParamTermType BNFC'Position
_loc Term' BNFC'Position
pat Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  ParamTermShape BNFC'Position
_loc Term' BNFC'Position
pat Term' BNFC'Position
cube Term' BNFC'Position
tope -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
    ]
  ParamTermModalType BNFC'Position
_loc Term' BNFC'Position
pat ModalColon
mc Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
pat, ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc, Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  ParamTermModalShape BNFC'Position
_loc Term' BNFC'Position
pat ModalColon
mc Term' BNFC'Position
cube Term' BNFC'Position
tope -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
pat, ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc, Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube, Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope ]

tokenizeModalColon :: ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon :: ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc = ModalColon
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken ModalColon
mc SemanticTokenTypes
SemanticTokenTypes_Decorator []

tokenizeModality :: Modality -> [SemanticTokenAbsolute]
tokenizeModality :: Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
md = Modality
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Modality
md SemanticTokenTypes
SemanticTokenTypes_Decorator []

tokenizeModComp :: ModComp -> [SemanticTokenAbsolute]
tokenizeModComp :: ModComp' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeModComp = \case
  Single BNFC'Position
_loc Modality
md -> Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
md
  Comp BNFC'Position
_loc Modality
app Modality
inn -> Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
app [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. Semigroup a => a -> a -> a
<> Modality -> [SemanticTokenAbsolute]
tokenizeModality Modality
inn

tokenizeSigmaParam :: SigmaParam -> [SemanticTokenAbsolute]
tokenizeSigmaParam :: SigmaParam' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeSigmaParam = \case
  SigmaParam BNFC'Position
_loc Pattern
pat Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  SigmaParamModal BNFC'Position
_loc Pattern
pat ModalColon
mc Term' BNFC'Position
type_ -> [[SemanticTokenAbsolute]] -> [SemanticTokenAbsolute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
    , ModalColon -> [SemanticTokenAbsolute]
tokenizeModalColon ModalColon
mc
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]

mkToken :: (HasPosition a, Print a) => a -> SemanticTokenTypes -> [SemanticTokenModifiers] -> [SemanticTokenAbsolute]
mkToken :: forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken a
x SemanticTokenTypes
tokenType [SemanticTokenModifiers]
tokenModifiers =
  case a -> BNFC'Position
forall a. HasPosition a => a -> BNFC'Position
hasPosition a
x of
    BNFC'Position
Nothing -> []
    Just (Int
line, Int
col) -> do
      [ SemanticTokenAbsolute
        { _tokenType :: SemanticTokenTypes
_tokenType = SemanticTokenTypes
tokenType
        , _tokenModifiers :: [SemanticTokenModifiers]
_tokenModifiers = [SemanticTokenModifiers]
tokenModifiers
        , _startChar :: UInt
_startChar = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
col UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1    -- NOTE: 0-indexed output for VS Code
        ,  _line :: UInt
_line = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1             -- NOTE: 0-indexed output for VS Code
        ,  _length :: UInt
_length = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (a -> String
forall a. Print a => a -> String
printTree a
x)
        }
        ]

-- * Syntax highlighting from the token stream

-- | Highlight the fixed syntax of the language (command names, reserved
-- words, operators) and holes directly from the lexer token stream.
--
-- This complements 'tokenizeModule', which highlights identifiers and
-- special term formers from the parsed module. Fixed symbols do not need
-- parsing at all: a @:=@ is a @:=@ wherever it occurs, and a hole @?@ (or
-- @?name@) is its own lexer token. Working on the token stream means that
-- the grammar (and the abstract syntax) does not have to track positions of
-- keywords, and that highlighting keeps working for files that
-- (temporarily) fail to parse.
tokenizeSyntaxSymbols :: T.Text -> [SemanticTokenAbsolute]
tokenizeSyntaxSymbols :: Text -> [SemanticTokenAbsolute]
tokenizeSyntaxSymbols Text
input =
  [ SemanticTokenAbsolute
      { _tokenType :: SemanticTokenTypes
_tokenType = SemanticTokenTypes
tokenType
      , _tokenModifiers :: [SemanticTokenModifiers]
_tokenModifiers = []
      , _line :: UInt
_line = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1      -- NOTE: 0-indexed output for LSP
      , _startChar :: UInt
_startChar = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
col UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1  -- NOTE: 0-indexed output for LSP
      , _length :: UInt
_length = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
sym)
      }
  | PT (Pn Int
_ Int
line Int
col) Tok
tok <- Text -> [Token]
Lex.tokens (Text -> Text -> Text
tryExtractMarkdownCodeBlocks Text
"rzk" Text
input)
  , Just (Text
sym, SemanticTokenTypes
tokenType) <- [Tok -> Maybe (Text, SemanticTokenTypes)
classifyToken Tok
tok]
  ]

-- | How to highlight a lexer token, if at all: fixed symbols by
-- 'classifySymbol', holes as a distinct token. Identifiers are left to the
-- AST pass ('tokenizeModule'), which knows their role.
classifyToken :: Tok -> Maybe (T.Text, SemanticTokenTypes)
classifyToken :: Tok -> Maybe (Text, SemanticTokenTypes)
classifyToken = \case
  TK (TokSymbol Text
sym Int
_) -> (,) Text
sym (SemanticTokenTypes -> (Text, SemanticTokenTypes))
-> Maybe SemanticTokenTypes -> Maybe (Text, SemanticTokenTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe SemanticTokenTypes
classifySymbol Text
sym
  -- Holes are goals to come back to, so they should stand out; among the
  -- standard token types, regexp is rendered most distinctly by the default
  -- themes (themes and clients may restyle it).
  T_HoleIdentToken Text
sym -> (Text, SemanticTokenTypes) -> Maybe (Text, SemanticTokenTypes)
forall a. a -> Maybe a
Just (Text
sym, SemanticTokenTypes
SemanticTokenTypes_Regexp)
  Tok
_                    -> Maybe (Text, SemanticTokenTypes)
forall a. Maybe a
Nothing

-- | How to highlight a fixed symbol of the grammar, if at all.
classifySymbol :: T.Text -> Maybe SemanticTokenTypes
classifySymbol :: Text -> Maybe SemanticTokenTypes
classifySymbol Text
s
  | Text
s Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ignored     = Maybe SemanticTokenTypes
forall a. Maybe a
Nothing
  | Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
s = SemanticTokenTypes -> Maybe SemanticTokenTypes
forall a. a -> Maybe a
Just SemanticTokenTypes
SemanticTokenTypes_Macro
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"rzk-1"         = SemanticTokenTypes -> Maybe SemanticTokenTypes
forall a. a -> Maybe a
Just SemanticTokenTypes
SemanticTokenTypes_Macro
  | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isAlphaNum Text
s   = SemanticTokenTypes -> Maybe SemanticTokenTypes
forall a. a -> Maybe a
Just SemanticTokenTypes
SemanticTokenTypes_Keyword
  | Bool
otherwise            = SemanticTokenTypes -> Maybe SemanticTokenTypes
forall a. a -> Maybe a
Just SemanticTokenTypes
SemanticTokenTypes_Operator
  where
    -- Plain brackets are left to the editor (e.g. bracket pair colorization).
    -- @}@ is not among them: since the brace shape-parameters were removed,
    -- it occurs only as the closer of @=_{@ and @refl_{@, which classify as
    -- operators, so it takes the same colour as its opener.
    ignored :: [Text]
ignored = [Text
"(", Text
")", Text
"[", Text
"]", Text
"{", Text
";", Text
"<", Text
">"]

-- | Combine tokens from the parsed module with tokens from the raw symbol
-- stream. On overlap (same start position) the AST-based token wins, since
-- it carries more precise semantics (e.g. @unit@ as an enum member rather
-- than a keyword). The result is sorted by position, as required for the
-- LSP delta encoding.
mergeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
mergeTokens :: [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
mergeTokens [SemanticTokenAbsolute]
astTokens [SemanticTokenAbsolute]
symbolTokens = [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
go ((SemanticTokenAbsolute -> (UInt, UInt))
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SemanticTokenAbsolute -> (UInt, UInt)
key [SemanticTokenAbsolute]
astTokens) ((SemanticTokenAbsolute -> (UInt, UInt))
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SemanticTokenAbsolute -> (UInt, UInt)
key [SemanticTokenAbsolute]
symbolTokens)
  where
    key :: SemanticTokenAbsolute -> (UInt, UInt)
key SemanticTokenAbsolute
t = (SemanticTokenAbsolute -> UInt
_line SemanticTokenAbsolute
t, SemanticTokenAbsolute -> UInt
_startChar SemanticTokenAbsolute
t)
    go :: [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
go [] [SemanticTokenAbsolute]
ss = [SemanticTokenAbsolute]
ss
    go [SemanticTokenAbsolute]
as [] = [SemanticTokenAbsolute]
as
    go (SemanticTokenAbsolute
a:[SemanticTokenAbsolute]
as) (SemanticTokenAbsolute
s:[SemanticTokenAbsolute]
ss) = case (UInt, UInt) -> (UInt, UInt) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SemanticTokenAbsolute -> (UInt, UInt)
key SemanticTokenAbsolute
a) (SemanticTokenAbsolute -> (UInt, UInt)
key SemanticTokenAbsolute
s) of
      Ordering
LT -> SemanticTokenAbsolute
a SemanticTokenAbsolute
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. a -> [a] -> [a]
: [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
go [SemanticTokenAbsolute]
as (SemanticTokenAbsolute
sSemanticTokenAbsolute
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. a -> [a] -> [a]
:[SemanticTokenAbsolute]
ss)
      Ordering
EQ -> SemanticTokenAbsolute
a SemanticTokenAbsolute
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. a -> [a] -> [a]
: [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
go [SemanticTokenAbsolute]
as [SemanticTokenAbsolute]
ss
      Ordering
GT -> SemanticTokenAbsolute
s SemanticTokenAbsolute
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. a -> [a] -> [a]
: [SemanticTokenAbsolute]
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
go (SemanticTokenAbsolute
aSemanticTokenAbsolute
-> [SemanticTokenAbsolute] -> [SemanticTokenAbsolute]
forall a. a -> [a] -> [a]
:[SemanticTokenAbsolute]
as) [SemanticTokenAbsolute]
ss