    {-|
      Copyright  :  (C) 2020, QBayLogic B.V.
      License    :  BSD2 (see the file LICENSE)
      Maintainer :  QBayLogic B.V. <devops@qbaylogic.com
    -}
    {-# LANGUAGE OverloadedStrings #-}

    module Clash.Netlist.Id.Verilog where

    import           Control.Applicative ((<|>))
    import qualified Data.Char as Char
    import           Data.Maybe (isJust, fromMaybe)
    import qualified Data.Text as Text
    import           Data.Text (Text)
    import           Data.HashSet (HashSet)
    import qualified Data.HashSet as HashSet

    import           Clash.Netlist.Id.Common
    import           Clash.Netlist.Types (IdentifierType(..))

    -- List of reserved Verilog-2005 keywords
    keywords :: HashSet Text
    keywords :: HashSet Text
    keywords = [Text] -> HashSet Text
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    HashSet.fromList
      [Text
    "always",Text
    "and",Text
    "assign",Text
    "automatic",Text
    "begin",Text
    "buf",Text
    "bufif0"
      ,Text
    "bufif1",Text
    "case",Text
    "casex",Text
    "casez",Text
    "cell",Text
    "cmos",Text
    "config",Text
    "deassign",Text
    "default"
      ,Text
    "defparam",Text
    "design",Text
    "disable",Text
    "edge",Text
    "else",Text
    "end",Text
    "endcase",Text
    "endconfig"
      ,Text
    "endfunction",Text
    "endgenerate",Text
    "endmodule",Text
    "endprimitive",Text
    "endspecify"
      ,Text
    "endtable",Text
    "endtask",Text
    "event",Text
    "for",Text
    "force",Text
    "forever",Text
    "fork",Text
    "function"
      ,Text
    "generate",Text
    "genvar",Text
    "highz0",Text
    "highz1",Text
    "if",Text
    "ifnone",Text
    "incdir",Text
    "include"
      ,Text
    "initial",Text
    "inout",Text
    "input",Text
    "instance",Text
    "integer",Text
    "join",Text
    "large",Text
    "liblist"
      ,Text
    "library",Text
    "localparam",Text
    "macromodule",Text
    "medium",Text
    "module",Text
    "nand",Text
    "negedge"
      ,Text
    "nmos",Text
    "nor",Text
    "noshowcancelled",Text
    "not",Text
    "notif0",Text
    "notif1",Text
    "or",Text
    "output"
      ,Text
    "parameter",Text
    "pmos",Text
    "posedge",Text
    "primitive",Text
    "pull0",Text
    "pull1",Text
    "pulldown",Text
    "pullup"
      ,Text
    "pulsestyle_onevent",Text
    "pulsestyle_ondetect",Text
    "rcmos",Text
    "real",Text
    "realtime",Text
    "reg"
      ,Text
    "release",Text
    "repeat",Text
    "rnmos",Text
    "rpmos",Text
    "rtran",Text
    "rtranif0",Text
    "rtranif1",Text
    "scalared"
      ,Text
    "showcancelled",Text
    "signed",Text
    "small",Text
    "specify",Text
    "specparam",Text
    "strong0",Text
    "strong1"
      ,Text
    "supply0",Text
    "supply1",Text
    "table",Text
    "task",Text
    "time",Text
    "tran",Text
    "tranif0",Text
    "tranif1",Text
    "tri"
      ,Text
    "tri0",Text
    "tri1",Text
    "triand",Text
    "trior",Text
    "trireg",Text
    "unsigned",Text
    "use",Text
    "uwire",Text
    "vectored"
      ,Text
    "wait",Text
    "wand",Text
    "weak0",Text
    "weak1",Text
    "while",Text
    "wire",Text
    "wor",Text
    "xnor",Text
    "xor"]

    isKeyword :: Text -> Bool
    isKeyword :: Text -> Bool
    isKeyword Text
    t = Text -> HashSet Text -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    HashSet.member (Text -> Text
    Text.toLower Text
    t) HashSet Text
    keywords

    parseBasic :: Text -> Bool
    parseBasic :: Text -> Bool
    parseBasic Text
    id0 = Text -> Bool
    parseBasic' Text
    id0 Bool -> Bool -> Bool
    && Bool -> Bool
    not (Text -> Bool
    isKeyword Text
    id0)

    parseBasic' :: Text -> Bool
    parseBasic' :: Text -> Bool
    parseBasic' Text
    id0 = Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Text -> Bool) -> Maybe Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
      Text
    id1 <- Text -> Maybe Text
    parseUnderscore Text
    id0 Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> Text -> Maybe Text
    parseLetter Text
    id0
      Text
    id2 <- (Text -> Maybe Text) -> Text -> Maybe Text
    repeatParse Text -> Maybe Text
    parseAllowedChars Text
    id1
      Text -> Maybe Text
    failNonEmpty Text
    id2
     where
      parseAllowedChars :: Text -> Maybe Text
    parseAllowedChars Text
    s =
            Text -> Maybe Text
    parseLetterOrDigit Text
    s
        Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> Text -> Maybe Text
    parseUnderscore Text
    s
        Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> Text -> Maybe Text
    parseDollar Text
    s

    parseExtended :: Text -> Bool
    parseExtended :: Text -> Bool
    parseExtended Text
    id0 =
      Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust ((Text -> Maybe Text
    parse Text
    id0 Maybe Text -> (Text -> Maybe Text) -> Maybe Text
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Text
    failNonEmpty) Maybe Text -> Maybe Text -> Maybe Text
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> Text -> Maybe Text
    parseEnd Text
    id0)
     where
      -- Extended identifier must start with backslash, followed by printable chars
      parse :: Text -> Maybe Text
    parse Text
    s = Text -> Maybe Text
    parseBackslash Text
    s Maybe Text -> (Text -> Maybe Text) -> Maybe Text
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Text -> Maybe Text) -> Text -> Maybe Text
    repeatParse Text -> Maybe Text
    parsePrintable

      -- Extended identifier must end in exactly one whitespace
      parseEnd :: Text -> Maybe Text
      parseEnd :: Text -> Maybe Text
    parseEnd Text
    s =
        case Text -> String
    Text.unpack (Int -> Text -> Text
    Text.takeEnd Int
    2 Text
    s) of
          [Char
    c0, Char
    c1] | Bool -> Bool
    not (Char -> Bool
    isWhiteSpace Char
    c0) Bool -> Bool -> Bool
    && Char -> Bool
    isWhiteSpace Char
    c1 -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ""
          String
    _ -> Maybe Text
    forall a. Maybe a
    Nothing

    toBasic' :: Text -> Text
    toBasic' :: Text -> Text
    toBasic' ((Char -> Bool) -> Text -> Text
    zEncode Char -> Bool
    isBasicChar -> Text
    t) =
      case Text -> Maybe (Char, Text)
    Text.uncons Text
    t of
        Just (Char
    c, Text
    _) | Char -> Bool
    Char.isDigit Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '$' -> Char -> Text -> Text
    Text.cons Char
    '_' Text
    t
        Maybe (Char, Text)
    _ -> Text
    t

    toBasic :: Text -> Text
    toBasic :: Text -> Text
    toBasic (Text -> Text
    toBasic' -> Text
    t) =
      if Text -> HashSet Text -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    HashSet.member (Text -> Text
    Text.toLower Text
    t) HashSet Text
    keywords then Text
    "r_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t else Text
    t

    isBasicChar :: Char -> Bool
    isBasicChar :: Char -> Bool
    isBasicChar Char
    c = [Bool] -> Bool
    forall (t :: Type -> Type). Foldable t => t Bool -> Bool
    or
      [ Char -> Bool
    Char.isAsciiLower Char
    c
      , Char -> Bool
    Char.isAsciiUpper Char
    c
      , Char -> Bool
    Char.isDigit Char
    c
      , Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'
      , Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '$'
      ]

    unextend :: Text -> Text
    unextend :: Text -> Text
    unextend =
         Text -> Text
    Text.strip
       (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\Text
    t -> Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    t (Text -> Text -> Maybe Text
    Text.stripPrefix Text
    "\\" Text
    t))
       (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    Text.strip

    toText :: IdentifierType -> Text -> Text
    toText :: IdentifierType -> Text -> Text
    toText IdentifierType
    Basic Text
    t = Text
    t
    toText IdentifierType
    Extended Text
    t = Text
    "\\" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " "