module Text.SDF.V2p1.Parser.SDFParser
(module Text.SDF.V2p1.Parser.SDFParser
,module Text.SDF.V2p1.Parser.SDFTypes
) where
import Text.Parsec
import qualified Text.Parsec.Token as P
import qualified Text.Parsec.Expr as E
import qualified Text.Parsec.Language as L
import Control.Applicative hiding ((<|>), many)
import Text.Parsec.ByteString.Lazy (Parser)
import Data.Functor.Identity (Identity)
import Text.SDF.V2p1.Parser.SDFTypes
sdflang :: P.GenLanguageDef SdfString a Identity
sdflang = L.emptyDef
{P.commentStart = "/*"
,P.commentEnd = "*/"
,P.commentLine = "//"
,P.nestedComments = True
,P.identStart = letter
,P.identLetter = alphaNum <|> oneOf "_'"
,P.reservedNames =
["DELAYFILE", "SDFVERSION", "DESIGN", "DATE", "VENDOR", "PROGRAM"
,"VERSION", "DIVIDER", "VOLTAGE", "PROCESS", "TEMPERATURE", "TIMSCALE"
,"CELL", "CELLTYPE", "INSTANCE", "DELAY", "TIMINGCHECK", "TIMINGENV"
,"PATHPULSE", "PATHPULSEPERCENT", "ABSOLUTE", "INCREMENT", "IOPATH"
,"RETAIN", "COND", "CONDELSE", "PORT", "INTERCONNECT", "DEVICE"
,"SETUP", "HOLD", "SETUPHOLD", "RECOVERY", "REMOVAL", "RECREM"
,"SKEW", "WIDTH", "PERIOD", "NOCHANGE", "SCOND", "CCOND", "NAME"
,"EXCEPTION", "PATHCONSTRAINT", "PERIODCONSTRAINT", "SUM", "DIFF"
,"SKEWCONSTRAINT", "ARRIVAL", "DEPARTURE", "SLACK", "WAVEFORM"
,"posedge", "negedge", "01", "10", "0z", "z1", "1z", "z0"
,"1'b0", "1'b1", "1'B0", "1'B1", "'b0", "'b1", "'B0", "'B1", "0", "1"]
,P.reservedOpNames =
["+", "-", "!", "~", "&", "~&", "|", "~|", "^", "^~", "~^"
,"*", "/", "%", "==", "!=", "===", "!==", "&&", "||", "<", "<="
,">", ">=", ">>", "<<"]
,P.caseSensitive = False
,P.opStart = P.opLetter sdflang
,P.opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
}
parseSdf :: FilePath -> SdfString -> DelayFile
parseSdf f s = case parse delay_file f s of
Left err -> error $ show err
Right df -> df
lexer :: P.GenTokenParser SdfString a Identity
lexer = P.makeTokenParser sdflang
lexeme :: ParsecT SdfString u Identity a -> ParsecT SdfString u Identity a
lexeme = P.lexeme lexer
symbol :: String -> ParsecT SdfString u Identity String
symbol = P.symbol lexer
parens :: ParsecT SdfString u Identity a -> ParsecT SdfString u Identity a
parens = P.parens lexer
reserved :: String -> ParsecT SdfString u Identity ()
reserved = P.reserved lexer
reservedOp :: String -> ParsecT SdfString u Identity ()
reservedOp = P.reservedOp lexer
braces :: ParsecT SdfString u Identity a -> ParsecT SdfString u Identity a
braces = P.braces lexer
whiteSpace :: ParsecT SdfString u Identity ()
whiteSpace = P.whiteSpace lexer
qstring :: Parser String
qstring = lexeme $ between (char '"') (symbol "\"") (many (noneOf "\""))
number :: Parser Number
number = lexeme (try (read1 <$> many1 digit <*> (char '.' *> many1 digit) <*> (oneOf "eE" *> sign) <*> many1 digit)
<|> try (read2 <$> many1 digit <*> (char '.' *> many1 digit))
<|> try (read3 <$> many1 digit <*> (oneOf "eE" *> sign) <*> many1 digit)
<|> (read <$> many1 digit)
<?> "number")
where read1 d1 d2 s d3 = read $ d1 ++ "." ++ d2 ++ "e" ++ s ++ d3
read2 d1 d2 = read $ d1 ++ "." ++ d2
read3 d1 s d2 = read $ d1 ++ "e" ++ s ++ d2
rnumber :: Parser Rnumber
rnumber = lexeme $ neg <$> sign <*> number
where neg s n = case s of
"" -> n
"-" -> negate n
_ -> error "Unexpected sign character from function 'rnumber'"
dnumber :: Parser Dnumber
dnumber = lexeme $ read <$> ((char '+' <|> return '+') *> many1 digit)
tsvalue :: Parser Tsvalue
tsvalue = join <$> lexeme tsvalue_n <*> lexeme tsvalue_u
where tsvalue_n = try (string "100.0")
<|> try (string "10.0")
<|> try (string "1.0")
<|> try (string "100")
<|> try (string "10")
<|> string "1"
tsvalue_u = choice [string "ns", string "us", string "ps"]
join n u = n ++ " " ++ u
identifier :: Parser Identifier
identifier = lexeme identifier'
path :: Parser Identifier
path = lexeme $ concat <$> many1 (choice [identifier', hchar])
delay_file :: Parser DelayFile
delay_file = parens (reserved "DELAYFILE" *>
(DelayFile <$> sdf_header <*> many1 cell))
sdf_header :: Parser SdfHeader
sdf_header = SdfHeader <$> sdf_version
<*> maybeParser design_name
<*> maybeParser date
<*> maybeParser vendor
<*> maybeParser program_name
<*> maybeParser program_version
<*> maybeParser hierarchy_divider
<*> maybeParser voltage
<*> maybeParser process
<*> maybeParser temperature
<*> maybeParser time_scale
sdf_version :: Parser SdfVersion
sdf_version = sdf_simple "SDFVERSION" qstring
design_name :: Parser DesignName
design_name = sdf_simple "DESIGN" qstring
date :: Parser Date
date = sdf_simple "DATE" qstring
vendor :: Parser Vendor
vendor = sdf_simple "VENDOR" qstring
program_name :: Parser ProgramName
program_name = sdf_simple "PROGRAM" qstring
program_version :: Parser ProgramVersion
program_version = sdf_simple "VERSION" qstring
hierarchy_divider :: Parser HierarchyDivider
hierarchy_divider = sdf_simple "DIVIDER" hchar
hchar :: Parser String
hchar = choice [symbol ".", symbol "/"]
voltage :: Parser Voltage
voltage = sdf_simple "VOLTAGE" rtriple_or_rnumber
process :: Parser Process
process = sdf_simple "PROCESS" qstring
temperature :: Parser Temperature
temperature = sdf_simple "TEMPERATURE" rtriple_or_rnumber
time_scale :: Parser TimeScale
time_scale = sdf_simple "TIMESCALE" tsvalue
cell :: Parser Cell
cell = parens (reserved "CELL" *> (Cell <$> celltype <*> cell_instance <*> maybeParser correlation <*> many timing_spec))
celltype :: Parser Celltype
celltype = sdf_simple "CELLTYPE" qstring
cell_instance :: Parser CellInstance
cell_instance = try (sdf_simple "INSTANCE" (string "*") *> return ["*"])
<|> many1 (try instance')
instance' :: Parser Instance
instance' = sdf_simple "INSTANCE" (try path <|> return "")
correlation :: Parser Correlation
correlation = parens (reserved "CORRELATION" *> (Correlation <$> qstring <*> maybeParser corr_factor))
corr_factor :: Parser CorrFactor
corr_factor = many number
timing_spec :: Parser TimingSpec
timing_spec = try (TimingSpecDel <$> del_spec)
<|> try (TimingSpecTc <$> tc_spec)
<?> "timing_spec"
del_spec :: Parser DelSpec
del_spec = parens (reserved "DELAY" *> many1 deltype)
tc_spec :: Parser TcSpec
tc_spec = parens (reserved "TIMINGCHECK" *> many1 tc_def)
deltype :: Parser Deltype
deltype = parens (try (reserved "PATHPULSE" *> (DeltypePathpulse <$> maybeParser input_output_path <*> value <*> maybeParser value))
<|> try (reserved "GLOBALPATHPULSE" *> (DeltypeGlobalpathpulse <$> maybeParser input_output_path <*> value <*> maybeParser value))
<|> try (reserved "ABSOLUTE" *> (DeltypeAbsolute <$> many1 del_def))
<|> try (reserved "INCREMENT" *> (DeltypeIncrement <$> many1 del_def))
<?> "deltype")
input_output_path :: Parser InputOutputPath
input_output_path = InputOutputPath <$> port_path <*> port_path
del_def :: Parser DelDef
del_def = parens (try (reserved "IOPATH" *> (DelDefIopath <$> port_spec <*> port_path <*> rvalue_list))
<|> try (reserved "COND" *> (DelDefCond <$> conditional_port_expr <*> (symbol "(" *> reserved "IOPATH" *> port_spec) <*> port_path <*> (rvalue_list <* symbol ")")))
<|> try (reserved "PORT" *> (DelDefPort <$> port_path <*> rvalue_list))
<|> try (reserved "INTERCONNECT" *> (DelDefInterconnect <$> port_instance <*> port_instance <*> rvalue_list))
<|> try (reserved "NETDELAY" *> (DelDefNetdelay <$> net_spec <*> rvalue_list))
<|> try (reserved "DEVICE" *> (DelDefDevice <$> maybeParser port_instance <*> rvalue_list))
<?> "del_def"
)
net_spec :: Parser NetSpec
net_spec = NetSpec <$> maybeParser instance' <*> identifier
tc_def :: Parser TcDef
tc_def = try (TcDefTchkDef <$> tchk_def)
<|> (TcDefCnsDef <$> cns_def)
<?> "tc_def"
tchk_def :: Parser TchkDef
tchk_def = parens (try (reserved "SETUP" *> (TchkDefSetup <$> port_tchk <*> port_tchk <*> rvalue))
<|> try (reserved "HOLD" *> (TchkDefHold <$> port_tchk <*> port_tchk <*> rvalue))
<|> try (reserved "SETUPHOLD" *> (TchkDefSetuphold <$> port_tchk <*> port_tchk <*> rvalue <*> rvalue))
<|> try (reserved "RECOVERY" *> (TchkDefRecovery <$> port_tchk <*> port_tchk <*> rvalue))
<|> try (reserved "SKEW" *> (TchkDefSkew <$> port_tchk <*> port_tchk <*> rvalue))
<|> try (reserved "WIDTH" *> (TchkDefWidth <$> port_tchk <*> value))
<|> try (reserved "PERIOD" *> (TchkDefPeriod <$> port_tchk <*> value))
<|> try (reserved "NOCHANGE" *> (TchkDefNochange <$> port_tchk <*> port_tchk <*> rvalue <*> rvalue))
<?> "tchk_def"
)
cns_def :: Parser CnsDef
cns_def = parens (try (reserved "PATHCONSTRAINT" *> (CnsDefPathconstraint <$> port_instance <*> many1 port_instance <*> rvalue <*> rvalue))
<|> try (reserved "SUM" *> (CnsDefSum <$> constraint_path <*> many1 (try constraint_path) <*> rvalue <*> maybeParser rvalue))
<|> try (reserved "DIFF" *> (CnsDefDiff <$> constraint_path <*> constraint_path <*> value <*> maybeParser value))
<|> try (reserved "SKEWCONSTRAINT" *> (CnsDefSkewconstraint <$> port_spec <*> value))
<?> "cns_def")
port_tchk :: Parser PortTchk
port_tchk = try (PortTchkPortSpec <$> port_spec)
<|> parens (reserved "COND" *> (PortTchkCond <$> timing_check_condition <*> port_spec))
<?> "port_tchk"
constraint_path :: Parser ConstraintPath
constraint_path = parens ((,) <$> port_instance <*> port_instance)
port_spec :: Parser PortSpec
port_spec = try (PortSpecPortPath <$> port_path)
<|> (PortSpecPortEdge <$> port_edge)
<?> "port_spec"
port_edge :: Parser PortEdge
port_edge = parens (PortEdge <$> edge_identifier <*> port_path)
edge_identifier :: Parser EdgeIdentifier
edge_identifier = try (res "posedge")
<|> try (res "negedge")
<|> try (res "01")
<|> try (res "10")
<|> try (res "0z")
<|> try (res "z1")
<|> try (res "1z")
<|> try (res "z0")
<?> "edge_identifier"
where res r = reserved r *> return r
port_path :: Parser PortPath
port_path = path
port :: Parser Port
port = scalar_port <|> bus_port
scalar_port :: Parser ScalarPort
scalar_port = identifier
bus_port :: Parser BusPort
bus_port = identifier
port_instance :: Parser PortInstance
port_instance = PortInstance <$> maybeParser instance' <*> port_path
value :: Parser Triple
value = valueOrRvalue number
triple :: Parser Triple
triple = tripleOrRtriple number
rvalue :: Parser Triple
rvalue = valueOrRvalue rnumber
rtriple :: Parser Triple
rtriple = tripleOrRtriple rnumber
rvalue_list :: Parser RvalueList
rvalue_list = many1 rvalue
conditional_port_expr :: Parser String
conditional_port_expr = simple_expression
simple_expression :: Parser String
simple_expression = E.buildExpressionParser table factor <?> "simple_expression"
where table =
[map unary unary_operator
,map unary inversion_operator
,map binary binary_operator
,map binary equality_operator
]
where unary op = E.Prefix (reservedOpNaive op *> return (op++))
binary op = E.Infix (reservedOpNaive op *> return (\a b -> a++op++b)) E.AssocLeft
factor = (\s -> "("++s++")") <$> parens simple_expression
<|> (\s -> "{"++s++"}") <$> braces simple_expression
<|> scalar_constant
<|> port
<?> "simple_expression"
reservedOpNaive name = try (symbol name)
timing_check_condition :: Parser TimingCheckCondition
timing_check_condition = simple_expression
scalar_constant :: Parser String
scalar_constant = try (res "1'b0")
<|> try (res "1'b1")
<|> try (res "1'B0")
<|> try (res "1'B1")
<|> try (res "'b0")
<|> try (res "'b1")
<|> try (res "'B0")
<|> try (res "'B1")
<|> try (res "0")
<|> try (res "1")
<?> "edge_identifier"
where res r = reserved r *> return r
unary_operator :: [String]
unary_operator = ["~|","~^","~&","~","|","^~","^","-","+","&","!"]
inversion_operator :: [String]
inversion_operator = ["!", "~"]
binary_operator :: [String]
binary_operator = ["~^","||","|","^~","^",">>",">=",">","===","==","<=","<<"
,"<","/","-",",","+","*","&&","&","%","!==","!="]
equality_operator :: [String]
equality_operator = ["===","==","!==","!="]
maybeParser :: Parser a -> Parser (Maybe a)
maybeParser p = try (Just <$> p)
<|> return Nothing
sdf_simple :: String -> Parser a -> Parser a
sdf_simple name p = parens (reserved name *> p)
rtriple_or_rnumber :: Parser Rtriple
rtriple_or_rnumber = try rtriple
<|> (\n -> (Just n, Just n, Just n)) <$> rnumber
valueOrRvalue :: Parser Double -> Parser Triple
valueOrRvalue numOrRnum = parens (try (tripleOrRtriple numOrRnum)
<|> try ((\n -> (Just n, Just n, Just n)) <$> numOrRnum)
<?> "value or rvalue")
posOrNegPair :: String
-> String
-> Parser ((Rnumber, Maybe Rnumber), (Rnumber, Maybe Rnumber))
posOrNegPair name1 name2 = (,)
<$> parens (reserved name1 *> ((,) <$> rnumber <*> maybeParser rnumber))
<*> parens (reserved name2 *> ((,) <$> rnumber <*> maybeParser rnumber))
sign :: Parser String
sign = choice [string "-", string "+", string ""]
tripleOrRtriple :: Parser Double -> Parser Triple
tripleOrRtriple numOrRnum =
try ((,,) <$> (Just <$> numOrRnum)
<*> (symbol ":" *> maybeParser numOrRnum)
<*> (symbol ":" *> maybeParser numOrRnum))
<|> try ((,,) <$> maybeParser numOrRnum
<*> (symbol ":" *> (Just <$> numOrRnum))
<*> (symbol ":" *> maybeParser numOrRnum))
<|> try ((,,) <$> maybeParser numOrRnum
<*> (symbol ":" *> maybeParser numOrRnum)
<*> (symbol ":" *> (Just <$> numOrRnum)))
<?> "triple or rtriple"
identifier' :: Parser Identifier
identifier' = many1 (validChar <|> (backslashChar *> specialChar))
where backslashChar = char '\\'
validChar = choice [alphaNum, oneOf "_:[]"]
specialChar = oneOf "!\"#$%%'()*+,-./:;<=>?@[\\]^`{|}~"