{-|
  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.SystemVerilog where

import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import qualified Clash.Netlist.Id.Verilog as Verilog

import           Clash.Netlist.Types (IdentifierType)

-- List of reserved SystemVerilog-2012 keywords
keywords :: HashSet Text
keywords :: HashSet Text
keywords = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
  [Text
"accept_on",Text
"alias",Text
"always",Text
"always_comb",Text
"always_ff"
  ,Text
"always_latch",Text
"and",Text
"assert",Text
"assign",Text
"assume",Text
"automatic",Text
"before",Text
"begin"
  ,Text
"bind",Text
"bins",Text
"binsof",Text
"bit",Text
"break",Text
"buf",Text
"bufif0",Text
"bufif1",Text
"byte",Text
"case"
  ,Text
"casex",Text
"casez",Text
"cell",Text
"chandle",Text
"checker",Text
"class",Text
"clocking",Text
"cmos",Text
"config"
  ,Text
"const",Text
"constraint",Text
"context",Text
"continue",Text
"cover",Text
"covergroup",Text
"coverpoint"
  ,Text
"cross",Text
"deassign",Text
"default",Text
"defparam",Text
"design",Text
"disable",Text
"dist",Text
"do",Text
"edge"
  ,Text
"else",Text
"end",Text
"endcase",Text
"endchecker",Text
"endclass",Text
"endclocking",Text
"endconfig"
  ,Text
"endfunction",Text
"endgenerate",Text
"endgroup",Text
"endinterface",Text
"endmodule",Text
"endpackage"
  ,Text
"endprimitive",Text
"endprogram",Text
"endproperty",Text
"endspecify",Text
"endsequence"
  ,Text
"endtable",Text
"endtask",Text
"enum",Text
"event",Text
"eventually",Text
"expect",Text
"export",Text
"extends"
  ,Text
"extern",Text
"final",Text
"first_match",Text
"for",Text
"force",Text
"foreach",Text
"forever",Text
"fork"
  ,Text
"forkjoin",Text
"function",Text
"generate",Text
"genvar",Text
"global",Text
"highz0",Text
"highz1",Text
"if"
  ,Text
"iff",Text
"ifnone",Text
"ignore_bins",Text
"illegal_bins",Text
"implements",Text
"implies",Text
"import"
  ,Text
"incdir",Text
"include",Text
"initial",Text
"inout",Text
"input",Text
"inside",Text
"instance",Text
"int"
  ,Text
"integer",Text
"interconnect",Text
"interface",Text
"intersect",Text
"join",Text
"join_any"
  ,Text
"join_none",Text
"large",Text
"let",Text
"liblist",Text
"library",Text
"local",Text
"localparam",Text
"logic"
  ,Text
"longint",Text
"macromodule",Text
"matches",Text
"medium",Text
"modport",Text
"module",Text
"nand"
  ,Text
"negedge",Text
"nettype",Text
"new",Text
"nexttime",Text
"nmos",Text
"nor",Text
"noshowcancelled",Text
"not"
  ,Text
"notif0",Text
"notif1",Text
"null",Text
"or",Text
"output",Text
"package",Text
"packed",Text
"parameter",Text
"pmos"
  ,Text
"posedge",Text
"primitive",Text
"priority",Text
"program",Text
"property",Text
"protected",Text
"pull0"
  ,Text
"pull1",Text
"pulldown",Text
"pullup",Text
"pulsestyle_ondetect",Text
"pulsestyle_onevent"
  ,Text
"pure",Text
"rand",Text
"randc",Text
"randcase",Text
"randsequence",Text
"rcmos",Text
"real",Text
"realtime"
  ,Text
"ref",Text
"reg",Text
"reject_on",Text
"release",Text
"repeat",Text
"restrict",Text
"return",Text
"rnmos"
  ,Text
"rpmos",Text
"rtran",Text
"rtranif0",Text
"rtranif1",Text
"s_always",Text
"s_eventually",Text
"s_nexttime"
  ,Text
"s_until",Text
"s_until_with",Text
"scalared",Text
"sequence",Text
"shortint",Text
"shortreal"
  ,Text
"showcancelled",Text
"signed",Text
"small",Text
"soft",Text
"solve",Text
"specify",Text
"specparam"
  ,Text
"static",Text
"string",Text
"strong",Text
"strong0",Text
"strong1",Text
"struct",Text
"super",Text
"supply0"
  ,Text
"supply1",Text
"sync_accept_on",Text
"sync_reject_on",Text
"table",Text
"tagged",Text
"task",Text
"this"
  ,Text
"throughout",Text
"time",Text
"timeprecision",Text
"timeunit",Text
"tran",Text
"tranif0",Text
"tranif1"
  ,Text
"tri",Text
"tri0",Text
"tri1",Text
"triand",Text
"trior",Text
"trireg",Text
"type",Text
"typedef",Text
"union"
  ,Text
"unique",Text
"unique0",Text
"unsigned",Text
"until",Text
"until_with",Text
"untyped",Text
"use",Text
"uwire"
  ,Text
"var",Text
"vectored",Text
"virtual",Text
"void",Text
"wait",Text
"wait_order",Text
"wand",Text
"weak",Text
"weak0"
  ,Text
"weak1",Text
"while",Text
"wildcard",Text
"wire",Text
"with",Text
"within",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
Verilog.parseBasic' Text
id0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
isKeyword Text
id0)

parseExtended :: Text -> Bool
parseExtended :: Text -> Bool
parseExtended = Text -> Bool
Verilog.parseExtended

toBasic :: Text -> Text
toBasic :: Text -> Text
toBasic (Text -> Text
Verilog.toBasic' -> Text
t) = if Text -> Bool
isKeyword Text
t then Text
"r_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t else Text
t

unextend :: Text -> Text
unextend :: Text -> Text
unextend = Text -> Text
Verilog.unextend

toText :: IdentifierType -> Text -> Text
toText :: IdentifierType -> Text -> Text
toText = IdentifierType -> Text -> Text
Verilog.toText