content: {-|
    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.fromList
    ["always","and","assign","automatic","begin","buf","bufif0"
    ,"bufif1","case","casex","casez","cell","cmos","config","deassign","default"
    ,"defparam","design","disable","edge","else","end","endcase","endconfig"
    ,"endfunction","endgenerate","endmodule","endprimitive","endspecify"
    ,"endtable","endtask","event","for","force","forever","fork","function"
    ,"generate","genvar","highz0","highz1","if","ifnone","incdir","include"
    ,"initial","inout","input","instance","integer","join","large","liblist"
    ,"library","localparam","macromodule","medium","module","nand","negedge"
    ,"nmos","nor","noshowcancelled","not","notif0","notif1","or","output"
    ,"parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup"
    ,"pulsestyle_onevent","pulsestyle_ondetect","rcmos","real","realtime","reg"
    ,"release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared"
    ,"showcancelled","signed","small","specify","specparam","strong0","strong1"
    ,"supply0","supply1","table","task","time","tran","tranif0","tranif1","tri"
    ,"tri0","tri1","triand","trior","trireg","unsigned","use","uwire","vectored"
    ,"wait","wand","weak0","weak1","while","wire","wor","xnor","xor"]
  
  isKeyword :: Text -> Bool
  isKeyword t = HashSet.member (Text.toLower t) keywords
  
  parseBasic :: Text -> Bool
  parseBasic id0 = parseBasic' id0 && not (isKeyword id0)
  
  parseBasic' :: Text -> Bool
  parseBasic' id0 = isJust $ do
    id1 <- parseUnderscore id0 <|> parseLetter id0
    id2 <- repeatParse parseAllowedChars id1
    failNonEmpty id2
   where
    parseAllowedChars s =
          parseLetterOrDigit s
      <|> parseUnderscore s
      <|> parseDollar s
  
  parseExtended :: Text -> Bool
  parseExtended id0 =
    isJust ((parse id0 >>= failNonEmpty) >> parseEnd id0)
   where
    -- Extended identifier must start with backslash, followed by printable chars
    parse s = parseBackslash s >>= repeatParse parsePrintable
  
    -- Extended identifier must end in exactly one whitespace
    parseEnd :: Text -> Maybe Text
    parseEnd s =
      case Text.unpack (Text.takeEnd 2 s) of
        [c0, c1] | not (isWhiteSpace c0) && isWhiteSpace c1 -> Just ""
        _ -> Nothing
  
  toBasic' :: Text -> Text
  toBasic' (zEncode isBasicChar -> t) =
    case Text.uncons t of
      Just (c, _) | Char.isDigit c || c == '$' -> Text.cons '_' t
      _ -> t
  
  toBasic :: Text -> Text
  toBasic (toBasic' -> t) =
    if HashSet.member (Text.toLower t) keywords then "r_" <> t else t
  
  isBasicChar :: Char -> Bool
  isBasicChar c = or
    [ Char.isAsciiLower c
    , Char.isAsciiUpper c
    , Char.isDigit c
    , c == '_'
    , c == '$'
    ]
  
  unextend :: Text -> Text
  unextend =
       Text.strip
     . (\t -> fromMaybe t (Text.stripPrefix "\\" t))
     . Text.strip
  
  toText :: IdentifierType -> Text -> Text
  toText Basic t = t
  toText Extended t = "\\" <> t <> " "
  