2019-02-08 05:49:12 +01:00
|
|
|
{
|
2019-03-29 10:19:11 +01:00
|
|
|
{- sv2v
|
|
|
|
|
- Author: Zachary Snow <zach@zachjs.com>
|
|
|
|
|
- Original Lexer Author: Tom Hawkins <tomahawkins@gmail.com>
|
|
|
|
|
-
|
|
|
|
|
- Combined source lexing and preprocessing
|
|
|
|
|
-
|
|
|
|
|
- These procedures are combined so that we can simultaneously process macros in
|
|
|
|
|
- a sane way (something analogous to character-by-character) and have our
|
|
|
|
|
- lexemes properly tagged with source file positions.
|
|
|
|
|
-
|
|
|
|
|
- The scariest piece of this module is the use of `unsafePerformIO`. We want to
|
|
|
|
|
- be able to search for and read files whenever we see an include directive.
|
|
|
|
|
- Trying to thread the IO Monad through alex's interface would be very
|
|
|
|
|
- convoluted. The operations performed are not effectful, and are type safe.
|
|
|
|
|
-}
|
|
|
|
|
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
|
|
|
|
-- The above pragma gets rid of annoying warning caused by alex 3.2.4. This has
|
|
|
|
|
-- been fixed on their development branch, so this can be removed once they roll
|
|
|
|
|
-- a new release. (no new release as of 3/29/2018)
|
|
|
|
|
module Language.SystemVerilog.Parser.Lex (lexFile) where
|
|
|
|
|
|
|
|
|
|
import System.FilePath (dropFileName)
|
|
|
|
|
import System.Directory (findFile)
|
|
|
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
|
|
|
import qualified Data.Map.Strict as Map
|
2019-03-29 22:02:49 +01:00
|
|
|
import Data.List (findIndex, isPrefixOf)
|
|
|
|
|
import Data.List.Split (splitOn)
|
2019-02-08 05:49:12 +01:00
|
|
|
|
2019-02-08 06:19:39 +01:00
|
|
|
import Language.SystemVerilog.Parser.Tokens
|
2019-02-08 05:49:12 +01:00
|
|
|
}
|
|
|
|
|
|
2019-03-29 06:07:08 +01:00
|
|
|
%wrapper "monadUserState"
|
2019-02-08 05:49:12 +01:00
|
|
|
|
|
|
|
|
-- Numbers
|
|
|
|
|
|
|
|
|
|
$nonZeroDecimalDigit = [1-9]
|
|
|
|
|
$decimalDigit = [0-9]
|
2019-02-23 21:10:25 +01:00
|
|
|
@xDigit = [xX]
|
|
|
|
|
@zDigit = [zZ\?]
|
|
|
|
|
@binaryDigit = @xDigit | @zDigit | [0-1]
|
|
|
|
|
@octalDigit = @xDigit | @zDigit | [0-7]
|
|
|
|
|
@hexDigit = @xDigit | @zDigit | [0-9a-fA-F]
|
2019-02-08 05:49:12 +01:00
|
|
|
|
2019-03-22 21:57:13 +01:00
|
|
|
@decimalBase = "'" [sS]? [dD]
|
|
|
|
|
@binaryBase = "'" [sS]? [bB]
|
|
|
|
|
@octalBase = "'" [sS]? [oO]
|
|
|
|
|
@hexBase = "'" [sS]? [hH]
|
2019-02-08 05:49:12 +01:00
|
|
|
|
2019-02-23 21:10:25 +01:00
|
|
|
@binaryValue = @binaryDigit ("_" | @binaryDigit)*
|
2019-02-08 05:49:12 +01:00
|
|
|
@octalValue = @octalDigit ("_" | @octalDigit)*
|
|
|
|
|
@hexValue = @hexDigit ("_" | @hexDigit)*
|
|
|
|
|
|
|
|
|
|
@unsignedNumber = $decimalDigit ("_" | $decimalDigit)*
|
|
|
|
|
|
2019-03-26 20:21:06 +01:00
|
|
|
@sign = [\-\+]
|
|
|
|
|
@fixedPointNumber = @unsignedNumber "." @unsignedNumber
|
|
|
|
|
@floatingPointNumber = @unsignedNumber ("." @unsignedNumber)? [eE] @sign? @unsignedNumber
|
|
|
|
|
|
2019-03-22 07:01:48 +01:00
|
|
|
@size = @unsignedNumber " "?
|
2019-02-08 05:49:12 +01:00
|
|
|
|
2019-03-22 07:01:48 +01:00
|
|
|
@decimalNumber = @size? @decimalBase " "? @unsignedNumber
|
|
|
|
|
@binaryNumber = @size? @binaryBase " "? @binaryValue
|
|
|
|
|
@octalNumber = @size? @octalBase " "? @octalValue
|
|
|
|
|
@hexNumber = @size? @hexBase " "? @hexValue
|
2019-03-26 20:21:06 +01:00
|
|
|
@realNumber = @fixedPointNumber | @floatingPointNumber
|
2019-02-08 05:58:34 +01:00
|
|
|
|
2019-03-08 22:37:20 +01:00
|
|
|
@unbasedUnsizedLiteral = "'" ( 0 | 1 | x | X | z | Z )
|
|
|
|
|
|
|
|
|
|
@number
|
2019-03-29 06:07:08 +01:00
|
|
|
= @unsignedNumber
|
|
|
|
|
| @decimalNumber
|
|
|
|
|
| @octalNumber
|
|
|
|
|
| @binaryNumber
|
|
|
|
|
| @hexNumber
|
|
|
|
|
| @unbasedUnsizedLiteral
|
|
|
|
|
| @realNumber
|
2019-02-08 05:49:12 +01:00
|
|
|
|
|
|
|
|
-- Strings
|
|
|
|
|
|
2019-03-26 00:42:20 +01:00
|
|
|
@string = \" (\\\"|[^\"\r\n])* \"
|
2019-02-08 05:49:12 +01:00
|
|
|
|
|
|
|
|
-- Identifiers
|
|
|
|
|
|
|
|
|
|
@escapedIdentifier = "\" ($printable # $white)+ $white
|
|
|
|
|
@simpleIdentifier = [a-zA-Z_] [a-zA-Z0-9_\$]*
|
|
|
|
|
@systemIdentifier = "$" [a-zA-Z0-9_\$]+
|
|
|
|
|
|
2019-03-18 10:00:23 +01:00
|
|
|
-- Comments
|
|
|
|
|
|
2019-03-29 06:07:08 +01:00
|
|
|
@commentBlock = "/*"
|
|
|
|
|
@commentLine = "//"
|
2019-03-18 10:00:23 +01:00
|
|
|
|
|
|
|
|
-- Directives
|
|
|
|
|
|
|
|
|
|
@directive = "`" @simpleIdentifier
|
|
|
|
|
|
|
|
|
|
-- Whitespace
|
|
|
|
|
|
|
|
|
|
@newline = \n
|
|
|
|
|
@escapedNewline = \\\n
|
|
|
|
|
@whitespace = ($white # \n) | @escapedNewline
|
2019-02-08 05:49:12 +01:00
|
|
|
|
|
|
|
|
tokens :-
|
|
|
|
|
|
2019-03-29 06:07:08 +01:00
|
|
|
"always" { tok KW_always }
|
|
|
|
|
"always_comb" { tok KW_always_comb }
|
|
|
|
|
"always_ff" { tok KW_always_ff }
|
|
|
|
|
"always_latch" { tok KW_always_latch }
|
|
|
|
|
"and" { tok KW_and }
|
|
|
|
|
"assign" { tok KW_assign }
|
|
|
|
|
"automatic" { tok KW_automatic }
|
|
|
|
|
"begin" { tok KW_begin }
|
|
|
|
|
"bit" { tok KW_bit }
|
|
|
|
|
"buf" { tok KW_buf }
|
|
|
|
|
"byte" { tok KW_byte }
|
|
|
|
|
"case" { tok KW_case }
|
|
|
|
|
"casex" { tok KW_casex }
|
|
|
|
|
"casez" { tok KW_casez }
|
|
|
|
|
"default" { tok KW_default }
|
|
|
|
|
"defparam" { tok KW_defparam }
|
|
|
|
|
"do" { tok KW_do }
|
|
|
|
|
"else" { tok KW_else }
|
|
|
|
|
"end" { tok KW_end }
|
|
|
|
|
"endcase" { tok KW_endcase }
|
|
|
|
|
"endfunction" { tok KW_endfunction }
|
|
|
|
|
"endgenerate" { tok KW_endgenerate }
|
|
|
|
|
"endinterface" { tok KW_endinterface }
|
|
|
|
|
"endmodule" { tok KW_endmodule }
|
|
|
|
|
"endtask" { tok KW_endtask }
|
|
|
|
|
"enum" { tok KW_enum }
|
|
|
|
|
"extern" { tok KW_extern }
|
|
|
|
|
"for" { tok KW_for }
|
|
|
|
|
"forever" { tok KW_forever }
|
|
|
|
|
"function" { tok KW_function }
|
|
|
|
|
"generate" { tok KW_generate }
|
|
|
|
|
"genvar" { tok KW_genvar }
|
|
|
|
|
"if" { tok KW_if }
|
|
|
|
|
"initial" { tok KW_initial }
|
|
|
|
|
"inout" { tok KW_inout }
|
|
|
|
|
"input" { tok KW_input }
|
|
|
|
|
"int" { tok KW_int }
|
|
|
|
|
"integer" { tok KW_integer }
|
|
|
|
|
"interface" { tok KW_interface }
|
|
|
|
|
"localparam" { tok KW_localparam }
|
|
|
|
|
"logic" { tok KW_logic }
|
|
|
|
|
"longint" { tok KW_longint }
|
|
|
|
|
"modport" { tok KW_modport }
|
|
|
|
|
"module" { tok KW_module }
|
|
|
|
|
"nand" { tok KW_nand }
|
|
|
|
|
"negedge" { tok KW_negedge }
|
|
|
|
|
"nor" { tok KW_nor }
|
|
|
|
|
"not" { tok KW_not }
|
|
|
|
|
"or" { tok KW_or }
|
|
|
|
|
"output" { tok KW_output }
|
|
|
|
|
"packed" { tok KW_packed }
|
|
|
|
|
"parameter" { tok KW_parameter }
|
|
|
|
|
"posedge" { tok KW_posedge }
|
|
|
|
|
"real" { tok KW_real }
|
|
|
|
|
"realtime" { tok KW_realtime }
|
|
|
|
|
"reg" { tok KW_reg }
|
|
|
|
|
"repeat" { tok KW_repeat }
|
|
|
|
|
"return" { tok KW_return }
|
|
|
|
|
"shortint" { tok KW_shortint }
|
|
|
|
|
"shortreal" { tok KW_shortreal }
|
|
|
|
|
"signed" { tok KW_signed }
|
|
|
|
|
"static" { tok KW_static }
|
|
|
|
|
"struct" { tok KW_struct }
|
|
|
|
|
"supply0" { tok KW_supply0 }
|
|
|
|
|
"supply1" { tok KW_supply1 }
|
|
|
|
|
"task" { tok KW_task }
|
|
|
|
|
"time" { tok KW_time }
|
|
|
|
|
"tri" { tok KW_tri }
|
|
|
|
|
"tri0" { tok KW_tri0 }
|
|
|
|
|
"tri1" { tok KW_tri1 }
|
|
|
|
|
"triand" { tok KW_triand }
|
|
|
|
|
"trior" { tok KW_trior }
|
|
|
|
|
"trireg" { tok KW_trireg }
|
|
|
|
|
"typedef" { tok KW_typedef }
|
|
|
|
|
"unique" { tok KW_unique }
|
|
|
|
|
"unsigned" { tok KW_unsigned }
|
|
|
|
|
"uwire" { tok KW_uwire }
|
|
|
|
|
"wand" { tok KW_wand }
|
|
|
|
|
"while" { tok KW_while }
|
|
|
|
|
"wire" { tok KW_wire }
|
|
|
|
|
"wor" { tok KW_wor }
|
|
|
|
|
"xnor" { tok KW_xnor }
|
|
|
|
|
"xor" { tok KW_xor }
|
|
|
|
|
|
|
|
|
|
@simpleIdentifier { tok Id_simple }
|
|
|
|
|
@escapedIdentifier { tok Id_escaped }
|
|
|
|
|
@systemIdentifier { tok Id_system }
|
|
|
|
|
|
|
|
|
|
@number { tok Lit_number }
|
|
|
|
|
@string { tok Lit_string }
|
|
|
|
|
|
|
|
|
|
"(" { tok Sym_paren_l }
|
|
|
|
|
")" { tok Sym_paren_r }
|
|
|
|
|
"[" { tok Sym_brack_l }
|
|
|
|
|
"]" { tok Sym_brack_r }
|
|
|
|
|
"{" { tok Sym_brace_l }
|
|
|
|
|
"}" { tok Sym_brace_r }
|
|
|
|
|
"~" { tok Sym_tildy }
|
|
|
|
|
"!" { tok Sym_bang }
|
|
|
|
|
"@" { tok Sym_at }
|
|
|
|
|
"#" { tok Sym_pound }
|
|
|
|
|
"%" { tok Sym_percent }
|
|
|
|
|
"^" { tok Sym_hat }
|
|
|
|
|
"&" { tok Sym_amp }
|
|
|
|
|
"|" { tok Sym_bar }
|
|
|
|
|
"*" { tok Sym_aster }
|
|
|
|
|
"." { tok Sym_dot }
|
|
|
|
|
"," { tok Sym_comma }
|
|
|
|
|
":" { tok Sym_colon }
|
|
|
|
|
";" { tok Sym_semi }
|
|
|
|
|
"=" { tok Sym_eq }
|
|
|
|
|
"<" { tok Sym_lt }
|
|
|
|
|
">" { tok Sym_gt }
|
|
|
|
|
"+" { tok Sym_plus }
|
|
|
|
|
"-" { tok Sym_dash }
|
|
|
|
|
"?" { tok Sym_question }
|
|
|
|
|
"/" { tok Sym_slash }
|
|
|
|
|
"$" { tok Sym_dollar }
|
|
|
|
|
"'" { tok Sym_s_quote }
|
|
|
|
|
|
|
|
|
|
"~&" { tok Sym_tildy_amp }
|
|
|
|
|
"~|" { tok Sym_tildy_bar }
|
|
|
|
|
"~^" { tok Sym_tildy_hat }
|
|
|
|
|
"^~" { tok Sym_hat_tildy }
|
|
|
|
|
"==" { tok Sym_eq_eq }
|
|
|
|
|
"!=" { tok Sym_bang_eq }
|
|
|
|
|
"&&" { tok Sym_amp_amp }
|
|
|
|
|
"||" { tok Sym_bar_bar }
|
|
|
|
|
"**" { tok Sym_aster_aster }
|
|
|
|
|
"<=" { tok Sym_lt_eq }
|
|
|
|
|
">=" { tok Sym_gt_eq }
|
|
|
|
|
">>" { tok Sym_gt_gt }
|
|
|
|
|
"<<" { tok Sym_lt_lt }
|
|
|
|
|
"++" { tok Sym_plus_plus }
|
|
|
|
|
"--" { tok Sym_dash_dash }
|
|
|
|
|
"+=" { tok Sym_plus_eq }
|
|
|
|
|
"-=" { tok Sym_dash_eq }
|
|
|
|
|
"*=" { tok Sym_aster_eq }
|
|
|
|
|
"/=" { tok Sym_slash_eq }
|
|
|
|
|
"%=" { tok Sym_percent_eq }
|
|
|
|
|
"&=" { tok Sym_amp_eq }
|
|
|
|
|
"|=" { tok Sym_bar_eq }
|
|
|
|
|
"^=" { tok Sym_hat_eq }
|
|
|
|
|
"+:" { tok Sym_plus_colon }
|
|
|
|
|
"-:" { tok Sym_dash_colon }
|
|
|
|
|
"::" { tok Sym_colon_colon }
|
|
|
|
|
".*" { tok Sym_dot_aster }
|
|
|
|
|
"->" { tok Sym_dash_gt }
|
|
|
|
|
":=" { tok Sym_colon_eq }
|
|
|
|
|
":/" { tok Sym_colon_slash }
|
|
|
|
|
"##" { tok Sym_pound_pound }
|
|
|
|
|
"[*" { tok Sym_brack_l_aster }
|
|
|
|
|
"[=" { tok Sym_brack_l_eq }
|
|
|
|
|
"=>" { tok Sym_eq_gt }
|
|
|
|
|
"@*" { tok Sym_at_aster }
|
|
|
|
|
"(*" { tok Sym_paren_l_aster }
|
|
|
|
|
"*)" { tok Sym_aster_paren_r }
|
|
|
|
|
"*>" { tok Sym_aster_gt }
|
|
|
|
|
|
|
|
|
|
"===" { tok Sym_eq_eq_eq }
|
|
|
|
|
"!==" { tok Sym_bang_eq_eq }
|
|
|
|
|
"==?" { tok Sym_eq_eq_question }
|
|
|
|
|
"!=?" { tok Sym_bang_eq_question }
|
|
|
|
|
">>>" { tok Sym_gt_gt_gt }
|
|
|
|
|
"<<<" { tok Sym_lt_lt_lt }
|
|
|
|
|
"<<=" { tok Sym_lt_lt_eq }
|
|
|
|
|
">>=" { tok Sym_gt_gt_eq }
|
|
|
|
|
"|->" { tok Sym_bar_dash_gt }
|
|
|
|
|
"|=>" { tok Sym_bar_eq_gt }
|
|
|
|
|
"[->" { tok Sym_brack_l_dash_gt }
|
|
|
|
|
"@@(" { tok Sym_at_at_paren_l }
|
|
|
|
|
"(*)" { tok Sym_paren_l_aster_paren_r }
|
|
|
|
|
"->>" { tok Sym_dash_gt_gt }
|
|
|
|
|
"&&&" { tok Sym_amp_amp_amp }
|
|
|
|
|
|
|
|
|
|
"<<<=" { tok Sym_lt_lt_lt_eq }
|
|
|
|
|
">>>=" { tok Sym_gt_gt_gt_eq }
|
|
|
|
|
|
2019-03-29 10:19:11 +01:00
|
|
|
@directive { handleDirective }
|
2019-03-29 06:07:08 +01:00
|
|
|
@commentLine { removeUntil "\n" }
|
|
|
|
|
@commentBlock { removeUntil "*/" }
|
|
|
|
|
|
2019-03-29 10:19:11 +01:00
|
|
|
$white ;
|
2019-03-29 06:07:08 +01:00
|
|
|
|
|
|
|
|
. { tok Unknown }
|
2019-02-08 05:49:12 +01:00
|
|
|
|
|
|
|
|
{
|
2019-03-29 06:07:08 +01:00
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- our actions don't return any data
|
|
|
|
|
type Action = AlexInput -> Int -> Alex ()
|
|
|
|
|
|
|
|
|
|
-- keeps track of the state of an if-else cascade level
|
2019-03-29 10:19:11 +01:00
|
|
|
data Cond
|
|
|
|
|
= CurrentlyTrue
|
|
|
|
|
| PreviouslyTrue
|
|
|
|
|
| NeverTrue
|
|
|
|
|
deriving (Eq, Show)
|
2019-03-29 06:07:08 +01:00
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- our custom lexer state
|
2019-03-29 10:19:11 +01:00
|
|
|
data AlexUserState = LS
|
2019-03-29 18:59:51 +01:00
|
|
|
{ lsToks :: [Token] -- tokens read so far
|
|
|
|
|
, lsCurrFile :: FilePath -- currently active filename
|
2019-03-29 22:02:49 +01:00
|
|
|
, lsEnv :: Map.Map String (String, [String]) -- active macro definitions
|
2019-03-29 18:59:51 +01:00
|
|
|
, lsCondStack :: [Cond] -- if-else cascade state
|
|
|
|
|
, lsIncludePaths :: [FilePath] -- folders to search for includes
|
2019-03-29 10:19:11 +01:00
|
|
|
} deriving (Eq, Show)
|
2019-03-29 06:07:08 +01:00
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- this initial user state does not contain the initial filename, environment,
|
|
|
|
|
-- or include paths; alex requires that this be defined; we override it before
|
|
|
|
|
-- we begin the actual lexing procedure
|
2019-03-29 10:19:11 +01:00
|
|
|
alexInitUserState :: AlexUserState
|
|
|
|
|
alexInitUserState = LS [] "" Map.empty [] []
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- public-facing lexer entrypoint
|
2019-03-29 10:19:11 +01:00
|
|
|
lexFile :: [String] -> [(String, String)] -> FilePath -> IO [Token]
|
|
|
|
|
lexFile includePaths env path = do
|
|
|
|
|
str <- readFile path
|
|
|
|
|
let result = runAlex str $ setEnv >> alexMonadScan >> get
|
|
|
|
|
return $ case result of
|
|
|
|
|
Left msg -> error $ "Lexical Error: " ++ msg
|
2019-03-29 18:59:51 +01:00
|
|
|
Right finalState ->
|
|
|
|
|
if null $ lsCondStack finalState
|
|
|
|
|
then lsToks finalState
|
|
|
|
|
else error $ "unfinished conditional directives: " ++
|
|
|
|
|
(show $ length $ lsCondStack finalState)
|
2019-03-29 10:19:11 +01:00
|
|
|
where
|
2019-03-29 22:02:49 +01:00
|
|
|
initialEnv = Map.map (\a -> (a, [])) $ Map.fromList env
|
2019-03-29 10:19:11 +01:00
|
|
|
setEnv = modify $ \s -> s
|
|
|
|
|
{ lsEnv = initialEnv
|
|
|
|
|
, lsIncludePaths = includePaths
|
|
|
|
|
, lsCurrFile = path
|
|
|
|
|
}
|
2019-03-29 06:07:08 +01:00
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- invoked by alexMonadScan
|
|
|
|
|
alexEOF :: Alex ()
|
|
|
|
|
alexEOF = return ()
|
|
|
|
|
|
|
|
|
|
-- raises an alexError with the current file position appended
|
|
|
|
|
lexicalError :: String -> Alex a
|
|
|
|
|
lexicalError msg = do
|
2019-03-29 22:02:49 +01:00
|
|
|
(pn, _, _, _) <- alexGetInput
|
|
|
|
|
pos <- toTokPos pn
|
2019-03-29 18:59:51 +01:00
|
|
|
alexError $ msg ++ ", at " ++ show pos
|
|
|
|
|
|
|
|
|
|
-- get the current user state
|
2019-03-29 06:07:08 +01:00
|
|
|
get :: Alex AlexUserState
|
|
|
|
|
get = Alex $ \s -> Right (s, alex_ust s)
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- get the current user state and apply a function to it
|
2019-03-29 06:07:08 +01:00
|
|
|
gets :: (AlexUserState -> a) -> Alex a
|
|
|
|
|
gets f = get >>= return . f
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- apply a transformation to the current user state
|
2019-03-29 06:07:08 +01:00
|
|
|
modify :: (AlexUserState -> AlexUserState) -> Alex ()
|
|
|
|
|
modify f = Alex func
|
|
|
|
|
where func s = Right (s { alex_ust = new }, ())
|
|
|
|
|
where new = f (alex_ust s)
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- helpers specifically accessing the current file state
|
2019-03-29 10:19:11 +01:00
|
|
|
getCurrentFile :: Alex String
|
|
|
|
|
getCurrentFile = gets lsCurrFile
|
|
|
|
|
setCurrentFile :: String -> Alex ()
|
|
|
|
|
setCurrentFile x = modify $ \s -> s { lsCurrFile = x }
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- find the given file for inclusion
|
2019-03-29 10:19:11 +01:00
|
|
|
includeSearch :: FilePath -> Alex FilePath
|
|
|
|
|
includeSearch file = do
|
|
|
|
|
base <- getCurrentFile
|
|
|
|
|
includePaths <- gets lsIncludePaths
|
|
|
|
|
let directories = dropFileName base : includePaths
|
|
|
|
|
let result = unsafePerformIO $ findFile directories file
|
|
|
|
|
case result of
|
|
|
|
|
Just path -> return path
|
2019-03-29 18:59:51 +01:00
|
|
|
Nothing -> lexicalError $ "Could not find file " ++ show file ++
|
|
|
|
|
", included from " ++ show base
|
2019-03-29 10:19:11 +01:00
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- read in the given file
|
|
|
|
|
loadFile :: FilePath -> Alex String
|
|
|
|
|
loadFile = return . unsafePerformIO . readFile
|
2019-03-29 10:19:11 +01:00
|
|
|
|
|
|
|
|
isIdentChar :: Char -> Bool
|
|
|
|
|
isIdentChar ch =
|
|
|
|
|
('a' <= ch && ch <= 'z') ||
|
|
|
|
|
('A' <= ch && ch <= 'Z') ||
|
|
|
|
|
('0' <= ch && ch <= '9') ||
|
|
|
|
|
(ch == '_') || (ch == '$')
|
|
|
|
|
|
|
|
|
|
takeString :: Alex String
|
|
|
|
|
takeString = do
|
2019-03-29 18:59:51 +01:00
|
|
|
(pos, _, _, str) <- alexGetInput
|
2019-03-29 10:19:11 +01:00
|
|
|
let (x, rest) = span isIdentChar str
|
2019-03-29 18:59:51 +01:00
|
|
|
let lastChar = if null x then ' ' else last x
|
|
|
|
|
alexSetInput (foldl alexMove pos x, lastChar, [], rest)
|
2019-03-29 10:19:11 +01:00
|
|
|
return x
|
|
|
|
|
|
2019-03-29 22:02:49 +01:00
|
|
|
toTokPos :: AlexPosn -> Alex Position
|
|
|
|
|
toTokPos (AlexPn _ l c) = do
|
2019-03-29 10:19:11 +01:00
|
|
|
file <- getCurrentFile
|
|
|
|
|
return $ Position file l c
|
|
|
|
|
|
|
|
|
|
-- read tokens after the name until the first (un-escaped) newline
|
|
|
|
|
takeUntilNewline :: Alex String
|
|
|
|
|
takeUntilNewline = do
|
2019-03-29 18:59:51 +01:00
|
|
|
(pos, _, _, str) <- alexGetInput
|
2019-03-29 10:19:11 +01:00
|
|
|
case str of
|
|
|
|
|
[] -> return ""
|
|
|
|
|
'\n' : _ -> do
|
|
|
|
|
return ""
|
|
|
|
|
'\\' : '\n' : rest -> do
|
2019-03-29 18:59:51 +01:00
|
|
|
let newPos = alexMove (alexMove pos '\\') '\n'
|
|
|
|
|
alexSetInput (newPos, '\n', [], rest)
|
2019-03-29 10:19:11 +01:00
|
|
|
takeUntilNewline >>= return . (' ' :)
|
|
|
|
|
ch : rest -> do
|
2019-03-29 18:59:51 +01:00
|
|
|
let newPos = alexMove pos ch
|
|
|
|
|
alexSetInput (newPos, ch, [], rest)
|
2019-03-29 10:19:11 +01:00
|
|
|
takeUntilNewline >>= return . (ch :)
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- select characters up to and including the given character
|
|
|
|
|
takeThrough :: Char -> Alex String
|
|
|
|
|
takeThrough goal = do
|
|
|
|
|
(_, _, _, str) <- alexGetInput
|
|
|
|
|
if null str
|
|
|
|
|
then lexicalError $
|
|
|
|
|
"unexpected end of input, looking for " ++ (show goal)
|
|
|
|
|
else do
|
|
|
|
|
ch <- takeChar
|
|
|
|
|
if ch == goal
|
|
|
|
|
then return [ch]
|
|
|
|
|
else do
|
|
|
|
|
rest <- takeThrough goal
|
|
|
|
|
return $ ch : rest
|
|
|
|
|
|
|
|
|
|
-- pop one character from the input stream
|
|
|
|
|
takeChar :: Alex Char
|
|
|
|
|
takeChar = do
|
|
|
|
|
(pos, _, _, ch : str) <- alexGetInput
|
|
|
|
|
let newPos = alexMove pos ch
|
|
|
|
|
alexSetInput (newPos, ch, [], str)
|
|
|
|
|
return ch
|
|
|
|
|
|
|
|
|
|
-- drop spaces in the input until a non-space is reached or EOF
|
|
|
|
|
dropSpaces :: Alex ()
|
|
|
|
|
dropSpaces = do
|
|
|
|
|
(_, _, _, str) <- alexGetInput
|
|
|
|
|
if null str || head str /= ' '
|
|
|
|
|
then return ()
|
|
|
|
|
else dropSpace >> dropSpaces
|
|
|
|
|
where
|
|
|
|
|
dropSpace :: Alex ()
|
|
|
|
|
dropSpace = do
|
|
|
|
|
(pos, _, _, str) <- alexGetInput
|
|
|
|
|
case str of
|
|
|
|
|
[] -> return ()
|
|
|
|
|
' ' : rest -> alexSetInput (alexMove pos ' ', ' ', [], rest)
|
|
|
|
|
ch : _ -> lexicalError $ "expected ' ', but found: " ++ show ch
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- removes and returns a quoted string such as <foo.bar> or "foo.bar"
|
|
|
|
|
takeQuotedString :: Alex String
|
|
|
|
|
takeQuotedString = do
|
|
|
|
|
dropSpaces
|
|
|
|
|
ch <- takeChar
|
|
|
|
|
end <-
|
|
|
|
|
case ch of
|
|
|
|
|
'"' -> return '"'
|
|
|
|
|
'<' -> return '>'
|
|
|
|
|
_ -> lexicalError $ "bad beginning of include arg: " ++ (show ch)
|
|
|
|
|
rest <- takeThrough end
|
|
|
|
|
let res = ch : rest
|
|
|
|
|
if end == '>'
|
|
|
|
|
then lexicalError $ "library includes are not supported: " ++ res
|
|
|
|
|
else return res
|
|
|
|
|
|
2019-03-29 22:02:49 +01:00
|
|
|
peekChar :: Alex Char
|
|
|
|
|
peekChar = do
|
|
|
|
|
(_, _, _, str) <- alexGetInput
|
|
|
|
|
return $ if null str
|
|
|
|
|
then '\n'
|
|
|
|
|
else head str
|
|
|
|
|
|
|
|
|
|
takeMacroArgNames :: Alex [String]
|
|
|
|
|
takeMacroArgNames = do
|
|
|
|
|
dropSpaces
|
|
|
|
|
name <- takeString
|
|
|
|
|
dropSpaces
|
|
|
|
|
ch <- takeChar
|
|
|
|
|
rest <- case ch of
|
|
|
|
|
',' -> takeMacroArgNames
|
|
|
|
|
')' -> return []
|
|
|
|
|
_ -> lexicalError $ "unexpected char in macro defn. args: " ++ show ch
|
|
|
|
|
return $ name : rest
|
|
|
|
|
|
|
|
|
|
-- TODO FIXME: We don't currently support macro arguments with default values!
|
|
|
|
|
takeMacroDefinition :: Alex (String, [String])
|
|
|
|
|
takeMacroDefinition = do
|
|
|
|
|
leadCh <- peekChar
|
|
|
|
|
if leadCh /= '('
|
|
|
|
|
then do
|
|
|
|
|
body <- takeUntilNewline
|
|
|
|
|
return (body, [])
|
|
|
|
|
else do
|
|
|
|
|
'(' <- takeChar
|
|
|
|
|
args <- takeMacroArgNames
|
|
|
|
|
body <- takeUntilNewline
|
|
|
|
|
if null args
|
|
|
|
|
then lexicalError "macros cannot have 0 args"
|
|
|
|
|
else return (body, args)
|
|
|
|
|
|
|
|
|
|
-- TODO FIXME XXX: This currently assumes that macro arguments contain no commas
|
|
|
|
|
-- or parentheses, which obviously isn't valid. See 22.5.1 of the spec for
|
|
|
|
|
-- details on how to deal with macros with arguments.
|
|
|
|
|
takeMacroArguments :: Alex [String]
|
|
|
|
|
takeMacroArguments = do
|
|
|
|
|
dropSpaces
|
|
|
|
|
str <- takeThrough ')'
|
|
|
|
|
return $ splitOn "," str
|
|
|
|
|
|
|
|
|
|
-- TODO FIXME XXX: This doens't handle escape sequences in macros.
|
|
|
|
|
substituteArgs :: String -> [String] -> [String] -> String
|
|
|
|
|
substituteArgs "" _ _ = ""
|
|
|
|
|
substituteArgs body names args =
|
|
|
|
|
case findIndex isPresent names of
|
|
|
|
|
Nothing -> head body : substituteArgs (tail body) names args
|
|
|
|
|
Just idx ->
|
|
|
|
|
(args !! idx) ++ substituteArgs (drop nameLen body) names args
|
|
|
|
|
where nameLen = length $ names !! idx
|
|
|
|
|
where isPresent a = isPrefixOf a body
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
-- directives that must always be processed even if the current code block is
|
|
|
|
|
-- being excluded; we have to process conditions so we can match them up with
|
|
|
|
|
-- their ending tag, even if they're being skipped
|
|
|
|
|
unskippableDirectives :: [String]
|
|
|
|
|
unskippableDirectives = ["else", "elsif", "endif", "ifdef", "ifndef"]
|
|
|
|
|
|
2019-03-29 10:19:11 +01:00
|
|
|
handleDirective :: Action
|
2019-03-29 18:59:51 +01:00
|
|
|
handleDirective (posOrig, _, _, strOrig) len = do
|
|
|
|
|
let thisTokenStr = take len strOrig
|
|
|
|
|
let directive = tail $ thisTokenStr
|
|
|
|
|
let newPos = foldl alexMove posOrig thisTokenStr
|
|
|
|
|
alexSetInput (newPos, last thisTokenStr, [], drop len strOrig)
|
2019-03-29 10:19:11 +01:00
|
|
|
|
|
|
|
|
env <- gets lsEnv
|
|
|
|
|
tempInput <- alexGetInput
|
|
|
|
|
let dropUntilNewline = removeUntil "\n" tempInput 0
|
|
|
|
|
|
|
|
|
|
condStack <- gets lsCondStack
|
|
|
|
|
if not (null condStack)
|
|
|
|
|
&& head condStack /= CurrentlyTrue
|
|
|
|
|
&& not (elem directive unskippableDirectives)
|
|
|
|
|
then alexMonadScan
|
|
|
|
|
else case directive of
|
|
|
|
|
|
|
|
|
|
"default_nettype" -> dropUntilNewline
|
|
|
|
|
"timescale" -> dropUntilNewline
|
|
|
|
|
|
2019-03-29 22:02:49 +01:00
|
|
|
"__FILE__" -> do
|
|
|
|
|
tokPos <- toTokPos posOrig
|
|
|
|
|
currFile <- gets lsCurrFile
|
|
|
|
|
let tokStr = show currFile
|
|
|
|
|
modify $ push $ Token Lit_string tokStr tokPos
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"__LINE__" -> do
|
|
|
|
|
tokPos <- toTokPos posOrig
|
|
|
|
|
let Position _ currLine _ = tokPos
|
|
|
|
|
let tokStr = show currLine
|
|
|
|
|
modify $ push $ Token Lit_number tokStr tokPos
|
|
|
|
|
alexMonadScan
|
|
|
|
|
|
2019-03-29 18:59:51 +01:00
|
|
|
"include" -> do
|
|
|
|
|
quotedFilename <- takeQuotedString
|
|
|
|
|
inputFollow <- alexGetInput
|
|
|
|
|
fileFollow <- getCurrentFile
|
|
|
|
|
-- process the included file
|
|
|
|
|
let filename = init $ tail quotedFilename
|
|
|
|
|
path <- includeSearch filename
|
|
|
|
|
content <- loadFile path
|
|
|
|
|
let inputIncluded = (alexStartPos, ' ', [], content)
|
|
|
|
|
setCurrentFile path
|
|
|
|
|
alexSetInput inputIncluded
|
|
|
|
|
alexMonadScan
|
|
|
|
|
-- resume processing the original file
|
|
|
|
|
setCurrentFile fileFollow
|
|
|
|
|
alexSetInput inputFollow
|
|
|
|
|
alexMonadScan
|
|
|
|
|
|
2019-03-29 10:19:11 +01:00
|
|
|
"ifdef" -> do
|
2019-03-29 18:59:51 +01:00
|
|
|
dropSpaces
|
2019-03-29 10:19:11 +01:00
|
|
|
name <- takeString
|
|
|
|
|
let newCond = if Map.member name env
|
|
|
|
|
then CurrentlyTrue
|
|
|
|
|
else NeverTrue
|
|
|
|
|
modify $ \s -> s { lsCondStack = newCond : condStack }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"ifndef" -> do
|
2019-03-29 18:59:51 +01:00
|
|
|
dropSpaces
|
2019-03-29 10:19:11 +01:00
|
|
|
name <- takeString
|
|
|
|
|
let newCond = if Map.notMember name env
|
|
|
|
|
then CurrentlyTrue
|
|
|
|
|
else NeverTrue
|
|
|
|
|
modify $ \s -> s { lsCondStack = newCond : condStack }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"else" -> do
|
|
|
|
|
let newCond = if head condStack == NeverTrue
|
|
|
|
|
then CurrentlyTrue
|
|
|
|
|
else NeverTrue
|
|
|
|
|
modify $ \s -> s { lsCondStack = newCond : tail condStack }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"elsif" -> do
|
2019-03-29 18:59:51 +01:00
|
|
|
dropSpaces
|
2019-03-29 10:19:11 +01:00
|
|
|
name <- takeString
|
|
|
|
|
let currCond = head condStack
|
|
|
|
|
let newCond =
|
|
|
|
|
if currCond /= NeverTrue then
|
|
|
|
|
PreviouslyTrue
|
|
|
|
|
else if Map.member name env then
|
|
|
|
|
CurrentlyTrue
|
|
|
|
|
else
|
|
|
|
|
NeverTrue
|
|
|
|
|
modify $ \s -> s { lsCondStack = newCond : tail condStack }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"endif" -> do
|
|
|
|
|
modify $ \s -> s { lsCondStack = tail condStack }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
|
|
|
|
|
"define" -> do
|
|
|
|
|
-- TODO: We don't yet support macros with arguments!
|
2019-03-29 18:59:51 +01:00
|
|
|
dropSpaces
|
2019-03-29 10:19:11 +01:00
|
|
|
name <- takeString
|
2019-03-29 22:02:49 +01:00
|
|
|
defn <- takeMacroDefinition
|
2019-03-29 10:19:11 +01:00
|
|
|
modify $ \s -> s { lsEnv = Map.insert name defn env }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"undef" -> do
|
2019-03-29 18:59:51 +01:00
|
|
|
dropSpaces
|
2019-03-29 10:19:11 +01:00
|
|
|
name <- takeString
|
|
|
|
|
modify $ \s -> s { lsEnv = Map.delete name env }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
"undefineall" -> do
|
|
|
|
|
modify $ \s -> s { lsEnv = Map.empty }
|
|
|
|
|
alexMonadScan
|
|
|
|
|
|
|
|
|
|
_ -> do
|
|
|
|
|
case Map.lookup directive env of
|
2019-03-29 18:59:51 +01:00
|
|
|
Nothing -> lexicalError $ "Undefined macro: " ++ directive
|
2019-03-29 22:02:49 +01:00
|
|
|
Just (body, formalArgs) -> do
|
2019-03-29 10:19:11 +01:00
|
|
|
-- TODO: How should we track the file position when we
|
|
|
|
|
-- substitute in a macro?
|
2019-03-29 22:02:49 +01:00
|
|
|
replacement <- if null formalArgs
|
|
|
|
|
then return body
|
|
|
|
|
else do
|
|
|
|
|
actualArgs <- takeMacroArguments
|
|
|
|
|
if length formalArgs == length actualArgs
|
|
|
|
|
then return $ substituteArgs body formalArgs actualArgs
|
|
|
|
|
else lexicalError $
|
|
|
|
|
"different number of macro args: " ++
|
|
|
|
|
(show $ length formalArgs) ++ " vs. " ++
|
|
|
|
|
(show $ length actualArgs)
|
|
|
|
|
let size = length replacement
|
2019-03-29 18:59:51 +01:00
|
|
|
(AlexPn f l c, _, [], str) <- alexGetInput
|
2019-03-29 10:19:11 +01:00
|
|
|
let pos = AlexPn (f - size) l (c - size)
|
|
|
|
|
alexSetInput (pos, ' ', [], replacement ++ str)
|
|
|
|
|
alexMonadScan
|
|
|
|
|
|
2019-03-29 06:07:08 +01:00
|
|
|
-- remove characters from the input until the pattern is reached
|
|
|
|
|
removeUntil :: String -> Action
|
|
|
|
|
removeUntil pattern _ _ = loop
|
|
|
|
|
where
|
|
|
|
|
patternLen = length pattern
|
|
|
|
|
wantNewline = pattern == "\n"
|
|
|
|
|
loop = do
|
2019-03-29 18:59:51 +01:00
|
|
|
(pos, _, _, str) <- alexGetInput
|
2019-03-29 06:07:08 +01:00
|
|
|
let found = (null str && wantNewline)
|
|
|
|
|
|| pattern == take patternLen str
|
2019-03-29 18:59:51 +01:00
|
|
|
let nextPos = alexMove pos (head str)
|
2019-03-29 06:07:08 +01:00
|
|
|
let afterPos = if wantNewline
|
2019-03-29 18:59:51 +01:00
|
|
|
then alexMove pos '\n'
|
|
|
|
|
else foldl alexMove pos pattern
|
2019-03-29 06:07:08 +01:00
|
|
|
let (newPos, newStr) = if found
|
|
|
|
|
then (afterPos, drop patternLen str)
|
|
|
|
|
else (nextPos, drop 1 str)
|
2019-03-29 18:59:51 +01:00
|
|
|
if not found && null str
|
|
|
|
|
then lexicalError $ "Reached EOF while looking for: " ++
|
|
|
|
|
show pattern
|
|
|
|
|
else do
|
|
|
|
|
alexSetInput (newPos, ' ', [], newStr)
|
|
|
|
|
if found
|
|
|
|
|
then alexMonadScan
|
|
|
|
|
else loop
|
2019-03-29 06:07:08 +01:00
|
|
|
|
2019-03-29 22:02:49 +01:00
|
|
|
push :: Token -> AlexUserState -> AlexUserState
|
|
|
|
|
push t s = s { lsToks = (lsToks s) ++ [t] }
|
|
|
|
|
|
2019-03-29 06:07:08 +01:00
|
|
|
tok :: TokenName -> Action
|
2019-03-29 22:02:49 +01:00
|
|
|
tok tokId (pos, _, _, input) len = do
|
2019-03-29 10:19:11 +01:00
|
|
|
let tokStr = take len input
|
2019-03-29 22:02:49 +01:00
|
|
|
tokPos <- toTokPos pos
|
2019-03-29 10:19:11 +01:00
|
|
|
condStack <- gets lsCondStack
|
|
|
|
|
() <- if not (null condStack) && head condStack /= CurrentlyTrue
|
|
|
|
|
then modify id
|
|
|
|
|
else modify (push $ Token tokId tokStr tokPos)
|
|
|
|
|
alexMonadScan
|
2019-02-08 05:49:12 +01:00
|
|
|
}
|