-- | Utilies for the Haskell lexer specification.

module BNFC.Backend.Haskell.Utilities.Lexer where

import BNFC.Backend.Haskell.Utilities.Utils

import BNFC.CF

import BNFC.Prelude

import qualified Data.Map    as Map
import           Data.String (fromString)

import Prettyprinter


tokenName :: Token -> Doc ()
tokenName :: Token -> Doc ()
tokenName (Builtin BuiltinCat
BString)  = String -> Doc ()
forall a. IsString a => String -> a
fromString String
"TL"
tokenName (Builtin BuiltinCat
BInteger) = String -> Doc ()
forall a. IsString a => String -> a
fromString String
"TI"
tokenName (Builtin BuiltinCat
BDouble)  = String -> Doc ()
forall a. IsString a => String -> a
fromString String
"TD"
tokenName (Builtin BuiltinCat
BChar)    = String -> Doc ()
forall a. IsString a => String -> a
fromString String
"TC"
tokenName Token
Identifier         = String -> Doc ()
forall a. IsString a => String -> a
fromString String
"TV"
tokenName (UserDefined CatName
s)    = String -> Doc ()
forall a. IsString a => String -> a
fromString (String -> Doc ()) -> String -> Doc ()
forall a b. (a -> b) -> a -> b
$ (String
"T_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CatName -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList CatName
s

tokenComment :: Token -> Doc ()
tokenComment :: Token -> Doc ()
tokenComment (Builtin BuiltinCat
BString)  =
  String -> Doc ()
forall a. IsString a => String -> a
fromString String
"                     -- ^ String literal."
tokenComment (Builtin BuiltinCat
BInteger) =
  String -> Doc ()
forall a. IsString a => String -> a
fromString String
"                     -- ^ Integer literal."
tokenComment (Builtin BuiltinCat
BDouble)  =
  String -> Doc ()
forall a. IsString a => String -> a
fromString String
"                     -- ^ Float literal."
tokenComment (Builtin BuiltinCat
BChar)    =
  String -> Doc ()
forall a. IsString a => String -> a
fromString String
"                     -- ^ Character literal."
tokenComment Token
Identifier         =
  String -> Doc ()
forall a. IsString a => String -> a
fromString String
"                     -- ^ Identifier."
tokenComment (UserDefined CatName
_)    = Doc ()
forall ann. Doc ann
emptyDoc

isUserDefined :: Token -> Bool
isUserDefined :: Token -> Bool
isUserDefined (Builtin BuiltinCat
_)     = Bool
False
isUserDefined Token
Identifier      = Bool
False
isUserDefined (UserDefined CatName
_) = Bool
True

--------------------------------------------------------

-- Andreas, 2020-10-08, issue #292:
-- Since the produced lexer for Haskell and Ocaml only recognizes ASCII identifiers,
-- but _lbnfKeywords also contains those using unicode characters,
-- we have to reclassify any keyword using non-ASCII characters
-- as symbol.
unicodeAndSymbols :: LBNF -> [String]
unicodeAndSymbols :: LBNF -> [String]
unicodeAndSymbols LBNF
lbnf = [String]
keywords [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
symbols
  where
    -- keywords containing unicode characters
    keywords :: [String]
    keywords :: [String]
keywords =
      CatName -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (CatName -> String) -> (Keyword -> CatName) -> Keyword -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keyword -> CatName
theKeyword
      (Keyword -> String) -> [Keyword] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Map Keyword (List1 Position) -> [Keyword]
forall k a. Map k a -> [k]
Map.keys
        ((Keyword -> List1 Position -> Bool)
-> Map Keyword (List1 Position) -> Map Keyword (List1 Position)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
          -- does keyword contain unicode characters?
          (\Keyword
k List1 Position
_ -> (Bool -> Bool
not (Bool -> Bool) -> (CatName -> Bool) -> CatName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> CatName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii) (Keyword -> CatName
theKeyword Keyword
k))
          (LBNF -> Map Keyword (List1 Position)
_lbnfKeywords LBNF
lbnf))

    symbols :: [String]
    symbols :: [String]
symbols = CatName -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (CatName -> String) -> (Symbol -> CatName) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> CatName
theSymbol (Symbol -> String) -> [Symbol] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (List1 Position) -> [Symbol]
forall k a. Map k a -> [k]
Map.keys (LBNF -> Map Symbol (List1 Position)
_lbnfSymbols LBNF
lbnf)

asciiKeywords :: LBNF -> [String]
asciiKeywords :: LBNF -> [String]
asciiKeywords LBNF
lbnf =
  CatName -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (CatName -> String) -> (Keyword -> CatName) -> Keyword -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keyword -> CatName
theKeyword
  (Keyword -> String) -> [Keyword] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Map Keyword (List1 Position) -> [Keyword]
forall k a. Map k a -> [k]
Map.keys
    ((Keyword -> List1 Position -> Bool)
-> Map Keyword (List1 Position) -> Map Keyword (List1 Position)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Keyword
k List1 Position
_-> (Char -> Bool) -> CatName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii (Keyword -> CatName
theKeyword Keyword
k)) (LBNF -> Map Keyword (List1 Position)
_lbnfKeywords LBNF
lbnf))