| 
   Copyright   :   ( C ) 2020 , QBayLogic B.V. 
   License     :   BSD2 ( see the file LICENSE ) 
   Maintainer :   QBayLogic B.V. <  

  Copyright  :  (C) 2020, QBayLogic B.V.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  QBayLogic B.V. <
-}
{-# 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  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 <> " "

# LANGUAGE OverloadedStrings #
 Extended identifier must start with backslash, followed by printable chars
| 
   Copyright   :   ( C ) 2020 , QBayLogic B.V. 
   License     :   BSD2 ( see the file LICENSE ) 
   Maintainer :   QBayLogic B.V. <  

  Copyright  :  (C) 2020, QBayLogic B.V.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  QBayLogic B.V. <
-}

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