{-# LANGUAGE OverloadedStrings #-}
module Clash.Netlist.BlackBox.Parser
(runParse)
where
import Control.Applicative
import Data.Text.Lazy (Text, pack, unpack)
import qualified Data.Text.Lazy as Text
import Text.Parser.Combinators
import Text.Trifecta hiding (Err)
import Text.Trifecta.Delta
import Clash.Netlist.BlackBox.Types
runParse :: Text -> Result BlackBoxTemplate
runParse = parseString pBlackBoxD (Directed "" 0 0 0 0) . unpack
pBlackBoxD :: Parser BlackBoxTemplate
pBlackBoxD = some pElement
pElement :: Parser Element
pElement = pTagD
<|> C <$> pText
<|> C <$> (pack <$> string "~ ")
pText :: Parser Text
pText = pack <$> some (satisfyRange '\000' '\125')
pTagD :: Parser Element
pTagD = IF <$> (symbol "~IF" *> pTagE)
<*> (spaces *> (string "~THEN" *> pBlackBoxD))
<*> (string "~ELSE" *> pBlackBoxD <* string "~FI")
<|> D <$> pDecl
<|> pTagE
pDecl :: Parser Decl
pDecl = Decl <$> (symbol "~INST" *> natural') <*>
((:) <$> pOutput <*> many pInput) <* string "~INST"
pOutput :: Parser (BlackBoxTemplate,BlackBoxTemplate)
pOutput = symbol "~OUTPUT" *> symbol "<=" *> ((,) <$> (pBlackBoxE <* symbol "~") <*> pBlackBoxE) <* symbol "~"
pInput :: Parser (BlackBoxTemplate,BlackBoxTemplate)
pInput = symbol "~INPUT" *> symbol "<=" *> ((,) <$> (pBlackBoxE <* symbol "~") <*> pBlackBoxE) <* symbol "~"
pTagE :: Parser Element
pTagE = O True <$ string "~ERESULT"
<|> O False <$ string "~RESULT"
<|> I True <$> (string "~EARG" *> brackets' natural')
<|> Arg <$> (string "~ARGN" *> brackets' natural') <*> brackets' natural'
<|> I False <$> (string "~ARG" *> brackets' natural')
<|> L <$> (string "~LIT" *> brackets' natural')
<|> N <$> (string "~NAME" *> brackets' natural')
<|> Var <$> try (string "~VAR" *> brackets' pSigD) <*> brackets' natural'
<|> (Sym Text.empty) <$> (string "~SYM" *> brackets' natural')
<|> Typ Nothing <$ string "~TYPO"
<|> (Typ . Just) <$> try (string "~TYP" *> brackets' natural')
<|> TypM Nothing <$ string "~TYPMO"
<|> (TypM . Just) <$> (string "~TYPM" *> brackets' natural')
<|> Err Nothing <$ string "~ERRORO"
<|> (Err . Just) <$> (string "~ERROR" *> brackets' natural')
<|> TypElem <$> (string "~TYPEL" *> brackets' pTagE)
<|> IndexType <$> (string "~INDEXTYPE" *> brackets' pTagE)
<|> CompName <$ string "~COMPNAME"
<|> IncludeName <$ string "~INCLUDENAME"
<|> Size <$> (string "~SIZE" *> brackets' pTagE)
<|> Length <$> (string "~LENGTH" *> brackets' pTagE)
<|> Depth <$> (string "~DEPTH" *> brackets' pTagE)
<|> FilePath <$> (string "~FILE" *> brackets' pTagE)
<|> Gen <$> (True <$ string "~GENERATE")
<|> Gen <$> (False <$ string "~ENDGENERATE")
<|> (`SigD` Nothing) <$> (string "~SIGDO" *> brackets' pSigD)
<|> SigD <$> (string "~SIGD" *> brackets' pSigD) <*> (Just <$> (brackets' natural'))
<|> IW64 <$ string "~IW64"
<|> (HdlSyn Vivado) <$ string "~VIVADO"
<|> (HdlSyn Other) <$ string "~OTHERSYN"
<|> (BV True) <$> (string "~TOBV" *> brackets' pSigD) <*> brackets' pTagE
<|> (BV False) <$> (string "~FROMBV" *> brackets' pSigD) <*> brackets' pTagE
<|> Sel <$> (string "~SEL" *> brackets' pTagE) <*> brackets' natural'
<|> IsLit <$> (string "~ISLIT" *> brackets' natural')
<|> IsVar <$> (string "~ISVAR" *> brackets' natural')
<|> IsGated <$> (string "~ISGATED" *> brackets' natural')
<|> IsSync <$> (string "~ISSYNC" *> brackets' natural')
<|> StrCmp <$> (string "~STRCMP" *> brackets' pSigD) <*> brackets' natural'
<|> OutputWireReg <$> (string "~OUTPUTWIREREG" *> brackets' natural')
<|> GenSym <$> (string "~GENSYM" *> brackets' pSigD) <*> brackets' natural'
<|> And <$> (string "~AND" *> brackets' (commaSep pTagE))
<|> Vars <$> (string "~VARS" *> brackets' natural')
natural' :: TokenParsing m => m Int
natural' = fmap fromInteger natural
brackets' :: Parser a -> Parser a
brackets' p = char '[' *> p <* char ']'
pBlackBoxE :: Parser BlackBoxTemplate
pBlackBoxE = some pElemE
pElemE :: Parser Element
pElemE = pTagE
<|> C <$> pText
pSigD :: Parser [Element]
pSigD = some (pTagE <|> (C (pack "[") <$ (pack <$> string "[\\"))
<|> (C (pack "]") <$ (pack <$> string "\\]"))
<|> (C <$> (pack <$> some (satisfyRange '\000' '\90')))
<|> (C <$> (pack <$> some (satisfyRange '\94' '\125'))))