{-|
  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 (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 (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 (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 (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 (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 (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
" "