diff --git a/src/Convert/BlockDecl.hs b/src/Convert/BlockDecl.hs index 5769686..7256ff0 100644 --- a/src/Convert/BlockDecl.hs +++ b/src/Convert/BlockDecl.hs @@ -20,8 +20,8 @@ convert = $ traverseStmts $ convertStmt convertStmt :: Stmt -> Stmt -convertStmt (Block name decls stmts) = - Block name decls' stmts' +convertStmt (Block Seq name decls stmts) = + Block Seq name decls' stmts' where splitDecls = map splitDecl decls decls' = map fst splitDecls diff --git a/src/Convert/ForDecl.hs b/src/Convert/ForDecl.hs index 164d92e..aa7b372 100644 --- a/src/Convert/ForDecl.hs +++ b/src/Convert/ForDecl.hs @@ -11,8 +11,6 @@ module Convert.ForDecl (convert) where -import Data.Either (isLeft, isRight, lefts, rights) - import Convert.Traverse import Language.SystemVerilog.AST @@ -24,14 +22,14 @@ convert = ) convertGenItem :: GenItem -> GenItem -convertGenItem (GenFor (True, x, e) a b mbx c) = - GenBlock Nothing genItems +convertGenItem (GenFor (True, x, e) a b bx c) = + GenBlock "" genItems where - x' = (maybe "" (++ "_") mbx) ++ x + x' = if null bx then x else bx ++ "_" ++ x Generate genItems = traverseNestedModuleItems converter $ Generate $ [ GenModuleItem $ Genvar x' - , GenFor (False, x, e) a b mbx c + , GenFor (False, x, e) a b bx c ] converter = (traverseExprs $ traverseNestedExprs convertExpr) . @@ -45,33 +43,28 @@ convertGenItem (GenFor (True, x, e) a b mbx c) = convertGenItem other = other convertStmt :: Stmt -> Stmt -convertStmt (For [] cc asgns stmt) = +convertStmt (For (Left []) cc asgns stmt) = + convertStmt $ For (Right []) cc asgns stmt +convertStmt (For (Right []) cc asgns stmt) = convertStmt $ For inits cc asgns stmt - where inits = [Left $ dummyDecl (Just $ Number "0")] -convertStmt (orig @ (For [Right _] _ _ _)) = orig + where inits = Left [dummyDecl (Just $ Number "0")] +convertStmt (orig @ (For (Right [_]) _ _ _)) = orig -convertStmt (orig @ (For (inits @ (Left _: _)) cc asgns stmt)) = - if not $ all isLeft inits - then error $ "for loop has mix of decls and asgns: " ++ show orig - else Block - Nothing - decls - (initAsgns ++ [For [Right (lhs, expr)] cc asgns stmt]) +convertStmt (For (Left inits) cc asgns stmt) = + Block Seq "" decls $ + initAsgns ++ + [For (Right [(lhs, expr)]) cc asgns stmt] where - splitDecls = map splitDecl $ lefts inits + splitDecls = map splitDecl inits decls = map fst splitDecls initAsgns = map asgnStmt $ init $ map snd splitDecls (lhs, expr) = snd $ last splitDecls -convertStmt (orig @ (For inits cc asgns stmt)) = - if not $ all isRight inits - then error $ "for loop has mix of decls and asgns: " ++ show orig - else Block - Nothing - [] - (initAsgns ++ [For [Right (lhs, expr)] cc asgns stmt]) +convertStmt (For (Right origPairs) cc asgns stmt) = + Block Seq "" [] $ + initAsgns ++ + [For (Right [(lhs, expr)]) cc asgns stmt] where - origPairs = rights inits (lhs, expr) = last origPairs initAsgns = map asgnStmt $ init origPairs diff --git a/src/Convert/Foreach.hs b/src/Convert/Foreach.hs index d0b99e8..d409d78 100644 --- a/src/Convert/Foreach.hs +++ b/src/Convert/Foreach.hs @@ -25,7 +25,7 @@ convertStmt (Foreach x idxs stmt) = toLoop :: (Int, Maybe Identifier) -> (Stmt -> Stmt) toLoop (_, Nothing) = id toLoop (d, Just i) = - For [Left idxDecl] (Just cmp) [incr] + For (Left [idxDecl]) cmp [incr] where queryFn f = DimFn f (Right $ Ident x) (Number $ show d) idxDecl = Variable Local (IntegerAtom TInteger Unspecified) i [] diff --git a/src/Convert/NamedBlock.hs b/src/Convert/NamedBlock.hs index 7714a50..abf5724 100644 --- a/src/Convert/NamedBlock.hs +++ b/src/Convert/NamedBlock.hs @@ -26,19 +26,19 @@ convert asts = where runner = mapM . traverseDescriptionsM . traverseModuleItemsM . traverseStmtsM collectStmtM :: Stmt -> State Idents Stmt -collectStmtM (Block (Just x) decls stmts) = do +collectStmtM (Block kw x decls stmts) = do modify $ Set.insert x - return $ Block (Just x) decls stmts + return $ Block kw x decls stmts collectStmtM other = return other traverseStmtM :: Stmt -> State Idents Stmt -traverseStmtM (Block Nothing [] stmts) = - return $ Block Nothing [] stmts -traverseStmtM (Block Nothing decls stmts) = do +traverseStmtM (Block kw "" [] stmts) = + return $ Block kw "" [] stmts +traverseStmtM (Block kw "" decls stmts) = do names <- get let x = uniqueBlockName names modify $ Set.insert x - return $ Block (Just x) decls stmts + return $ Block kw x decls stmts traverseStmtM other = return other uniqueBlockName :: Idents -> Identifier diff --git a/src/Convert/StmtBlock.hs b/src/Convert/StmtBlock.hs index cbeeb73..bd5b0d1 100644 --- a/src/Convert/StmtBlock.hs +++ b/src/Convert/StmtBlock.hs @@ -27,4 +27,4 @@ convertPackageItem other = other stmtsToStmt :: [Stmt] -> Stmt stmtsToStmt [stmt] = stmt -stmtsToStmt stmts = Block Nothing [] stmts +stmtsToStmt stmts = Block Seq "" [] stmts diff --git a/src/Convert/Stream.hs b/src/Convert/Stream.hs index a926686..b2375d4 100644 --- a/src/Convert/Stream.hs +++ b/src/Convert/Stream.hs @@ -29,7 +29,7 @@ convertDescription other = other streamerBlock :: Expr -> Expr -> (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt streamerBlock chunk size asgn output input = - Block Nothing + Block Seq "" [ Variable Local t inp [] $ Just input , Variable Local t out [] Nothing , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nothing @@ -50,14 +50,14 @@ streamerBlock chunk size asgn output input = idx = name ++ "_idx" bas = name ++ "_bas" -- main chunk loop - inits = [Right (LHSIdent idx, lo)] - cmp = Just $ BinOp Le (Ident idx) (BinOp Sub hi chunk) + inits = Right [(LHSIdent idx, lo)] + cmp = BinOp Le (Ident idx) (BinOp Sub hi chunk) incr = [(LHSIdent idx, AsgnOp Add, chunk)] lhs = LHSRange (LHSIdent out) IndexedMinus (BinOp Sub hi (Ident idx), chunk) expr = Range (Ident inp) IndexedPlus (Ident idx, chunk) stmt = AsgnBlk AsgnOpEq lhs expr -- final chunk loop - cmp2 = Just $ BinOp Lt (Ident idx) (BinOp Sub size (Ident bas)) + cmp2 = BinOp Lt (Ident idx) (BinOp Sub size (Ident bas)) incr2 = [(LHSIdent idx, AsgnOp Add, Number "1")] lhs2 = LHSBit (LHSIdent out) (Ident idx) expr2 = Bit (Ident inp) (BinOp Add (Ident idx) (Ident bas)) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 5060573..0b0cd1e 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -126,7 +126,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d let items'' = concatMap breakGenerate items' return $ Part attrs extern kw lifetime name ports items'' where - fullMapper (Generate [GenBlock Nothing genItems]) = + fullMapper (Generate [GenBlock "" genItems]) = mapM fullGenItemMapper genItems >>= mapper . Generate fullMapper (Generate genItems) = do let genItems' = filter (/= GenNull) genItems @@ -138,7 +138,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d genItemMapper (GenModuleItem moduleItem) = do moduleItem' <- fullMapper moduleItem return $ case moduleItem' of - Generate subItems -> GenBlock Nothing subItems + Generate subItems -> GenBlock "" subItems _ -> GenModuleItem moduleItem' genItemMapper (GenIf (Number "1") s _) = return s genItemMapper (GenIf (Number "0") _ s) = return s @@ -228,9 +228,9 @@ traverseSinglyNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt traverseSinglyNestedStmtsM fullMapper = cs where cs (StmtAttr a stmt) = fullMapper stmt >>= return . StmtAttr a - cs (Block Nothing [] []) = return Null - cs (Block name decls stmts) = - mapM fullMapper stmts >>= return . Block name decls + cs (Block _ "" [] []) = return Null + cs (Block kw name decls stmts) = + mapM fullMapper stmts >>= return . Block kw name decls cs (Case u kw expr cases def) = do caseStmts <- mapM fullMapper $ map snd cases let cases' = zip (map fst cases) caseStmts @@ -373,16 +373,17 @@ traverseStmtLHSsM mapper = stmtMapper stmtMapper (AsgnBlk op lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk op lhs' expr stmtMapper (Asgn mt lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn mt lhs' expr stmtMapper (For inits me incrs stmt) = do - inits' <- mapM mapInit inits + inits' <- mapInits inits let (lhss, asgnOps, exprs) = unzip3 incrs lhss' <- mapM fullMapper lhss let incrs' = zip3 lhss' asgnOps exprs return $ For inits' me incrs' stmt where - mapInit (Left decl) = return $ Left decl - mapInit (Right (lhs, expr)) = do - lhs' <- fullMapper lhs - return $ Right (lhs', expr) + mapInits (Left decls) = return $ Left decls + mapInits (Right asgns) = do + let (lhss, exprs) = unzip asgns + lhss' <- mapM fullMapper lhss + return $ Right $ zip lhss' exprs stmtMapper (Assertion a) = assertionMapper a >>= return . Assertion stmtMapper other = return other @@ -664,9 +665,9 @@ traverseStmtExprsM exprMapper = flatStmtMapper flatStmtMapper (StmtAttr attr stmt) = -- note: we exclude expressions in attributes from conversion return $ StmtAttr attr stmt - flatStmtMapper (Block name decls stmts) = do + flatStmtMapper (Block kw name decls stmts) = do decls' <- mapM declMapper decls - return $ Block name decls' stmts + return $ Block kw name decls' stmts flatStmtMapper (Case u kw e cases def) = do e' <- exprMapper e cases' <- mapM caseMapper cases @@ -680,8 +681,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper expr' <- exprMapper expr return $ Asgn mt lhs' expr' flatStmtMapper (For inits cc asgns stmt) = do - inits' <- mapM initMapper inits - cc' <- maybeExprMapper cc + inits' <- initsMapper inits + cc' <- exprMapper cc asgns' <- mapM asgnMapper asgns return $ For inits' cc' asgns' stmt flatStmtMapper (While e stmt) = @@ -709,8 +710,9 @@ traverseStmtExprsM exprMapper = flatStmtMapper return $ Assertion a'' flatStmtMapper (Null) = return Null - initMapper (Left decl) = declMapper decl >>= return . Left - initMapper (Right (l, e)) = exprMapper e >>= \e' -> return $ Right (l, e') + initsMapper (Left decls) = mapM declMapper decls >>= return . Left + initsMapper (Right asgns) = mapM mapper asgns >>= return . Right + where mapper (l, e) = exprMapper e >>= return . (,) l asgnMapper (l, op, e) = exprMapper e >>= \e' -> return $ (l, op, e') @@ -802,9 +804,9 @@ traverseDeclsM' strat mapper item = do else return decls return $ MIPackageItem $ Task l x decls' stmts miMapper other = return other - stmtMapper (Block name decls stmts) = do + stmtMapper (Block kw name decls stmts) = do decls' <- mapM mapper decls - return $ Block name decls' stmts + return $ Block kw name decls' stmts stmtMapper other = return other traverseDecls' :: TFStrategy -> Mapper Decl -> Mapper ModuleItem @@ -938,7 +940,7 @@ traverseSinglyNestedGenItemsM fullMapper = gim return $ GenModuleItem moduleItem gim (GenNull) = return GenNull flattenBlocks :: GenItem -> [GenItem] - flattenBlocks (GenBlock Nothing items) = items + flattenBlocks (GenBlock "" items) = items flattenBlocks other = [other] traverseAsgnsM' :: Monad m => TFStrategy -> MapperM m (LHS, Expr) -> MapperM m ModuleItem @@ -1032,10 +1034,10 @@ traverseScopesM declMapper moduleItemMapper stmtMapper = nestedStmtMapper stmt = stmtMapper stmt >>= traverseSinglyNestedStmtsM fullStmtMapper - fullStmtMapper (Block name decls stmts) = do + fullStmtMapper (Block kw name decls stmts) = do prevState <- get decls' <- mapM declMapper decls - block <- nestedStmtMapper $ Block name decls' stmts + block <- nestedStmtMapper $ Block kw name decls' stmts put prevState return block fullStmtMapper other = nestedStmtMapper other diff --git a/src/Language/SystemVerilog/AST/GenItem.hs b/src/Language/SystemVerilog/AST/GenItem.hs index 70e0f18..e81948a 100644 --- a/src/Language/SystemVerilog/AST/GenItem.hs +++ b/src/Language/SystemVerilog/AST/GenItem.hs @@ -20,9 +20,9 @@ import Language.SystemVerilog.AST.Type (Identifier) import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem) data GenItem - = GenBlock (Maybe Identifier) [GenItem] + = GenBlock Identifier [GenItem] | GenCase Expr [GenCase] (Maybe GenItem) - | GenFor (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) (Maybe Identifier) [GenItem] + | GenFor (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) Identifier [GenItem] | GenIf Expr GenItem GenItem | GenNull | GenModuleItem ModuleItem @@ -30,9 +30,9 @@ data GenItem instance Show GenItem where showList i _ = unlines' $ map show i - show (GenBlock mx i) = + show (GenBlock x i) = printf "begin%s\n%s\nend" - (maybe "" (" : " ++) mx) + (if null x then "" else " : " ++ x) (indent $ unlines' $ map show i) show (GenCase e cs def) = printf "case (%s)\n%s%s\nendcase" (show e) bodyStr defStr @@ -43,13 +43,13 @@ instance Show GenItem where Just c -> printf "\n\tdefault: %s" (show c) show (GenIf e a GenNull) = printf "if (%s) %s" (show e) (show a) show (GenIf e a b ) = printf "if (%s) %s\nelse %s" (show e) (show a) (show b) - show (GenFor (new, x1, e1) c (x2, o2, e2) mx is) = + show (GenFor (new, x1, e1) c (x2, o2, e2) x is) = printf "for (%s%s = %s; %s; %s %s %s) %s" (if new then "genvar " else "") x1 (show e1) (show c) x2 (show o2) (show e2) - (show $ GenBlock mx is) + (show $ GenBlock x is) show (GenNull) = ";" show (GenModuleItem item) = show item diff --git a/src/Language/SystemVerilog/AST/Stmt.hs b/src/Language/SystemVerilog/AST/Stmt.hs index b80aced..364f55f 100644 --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/src/Language/SystemVerilog/AST/Stmt.hs @@ -20,6 +20,7 @@ module Language.SystemVerilog.AST.Stmt , Assertion (..) , PropertySpec (..) , UniquePriority (..) + , BlockKW (..) ) where import Text.Printf (printf) @@ -29,14 +30,14 @@ import Language.SystemVerilog.AST.Attr (Attr) import Language.SystemVerilog.AST.Decl (Decl) import Language.SystemVerilog.AST.Expr (Expr, Args) import Language.SystemVerilog.AST.LHS (LHS) -import Language.SystemVerilog.AST.Op (AsgnOp) +import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq)) import Language.SystemVerilog.AST.Type (Identifier) data Stmt = StmtAttr Attr Stmt - | Block (Maybe Identifier) [Decl] [Stmt] + | Block BlockKW Identifier [Decl] [Stmt] | Case (Maybe UniquePriority) CaseKW Expr [Case] (Maybe Stmt) - | For [Either Decl (LHS, Expr)] (Maybe Expr) [(LHS, AsgnOp, Expr)] Stmt + | For (Either [Decl] [(LHS, Expr)]) Expr [(LHS, AsgnOp, Expr)] Stmt | AsgnBlk AsgnOp LHS Expr | Asgn (Maybe Timing) LHS Expr | While Expr Stmt @@ -55,10 +56,10 @@ data Stmt instance Show Stmt where show (StmtAttr attr stmt) = printf "%s\n%s" (show attr) (show stmt) - show (Block name decls stmts) = - printf "begin%s\n%s\nend" header body + show (Block kw name decls stmts) = + printf "%s%s\n%s\n%s" (show kw) header body (blockEndToken kw) where - header = maybe "" (" : " ++) name + header = if null name then "" else " : " ++ name bodyLines = (map show decls) ++ (map show stmts) body = indent $ unlines' bodyLines show (Case u kw e cs def) = @@ -68,16 +69,17 @@ instance Show Stmt where defStr = case def of Nothing -> "" Just c -> printf "\n\tdefault: %s" (show c) - show (For inits mc assigns stmt) = + show (For inits cond assigns stmt) = printf "for (%s; %s; %s)\n%s" - (commas $ map showInit inits) - (maybe "" show mc) + (showInits inits) + (show cond) (commas $ map showAssign assigns) (indent $ show stmt) where - showInit :: Either Decl (LHS, Expr) -> String - showInit (Left d) = init $ show d - showInit (Right (l, e)) = printf "%s = %s" (show l) (show e) + showInits :: Either [Decl] [(LHS, Expr)] -> String + showInits (Left decls) = commas $ map (init . show) decls + showInits (Right asgns) = commas $ map showInit asgns + where showInit (l, e) = showAssign (l, AsgnOpEq, e) showAssign :: (LHS, AsgnOp, Expr) -> String showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e) show (Subroutine ps x a) = printf "%s%s(%s);" (maybe "" (++ "::") ps) x (show a) @@ -221,3 +223,16 @@ instance Show UniquePriority where show Unique = "unique" show Unique0 = "unique0" show Priority = "priority" + +data BlockKW + = Seq + | Par + deriving Eq + +instance Show BlockKW where + show Seq = "begin" + show Par = "fork" + +blockEndToken :: BlockKW -> Identifier +blockEndToken Seq = "end" +blockEndToken Par = "join" diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index c577dae..4eaf7e7 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -518,6 +518,10 @@ PackageDeclaration :: { Description } Tag :: { Identifier } : ":" Identifier { $2 } +StrTag :: { Identifier } + : {- empty -} { "" } + | ":" Identifier { $2 } + PackageImportDeclarations :: { [ModuleItem] } : PackageImportDeclaration PackageImportDeclarations { $1 ++ $2 } | {- empty -} { [] } @@ -699,8 +703,8 @@ SeqMatchItems :: { [SeqMatchItem] } : "," SeqMatchItem { [$2] } | SeqMatchItems "," SeqMatchItem { $1 ++ [$3] } SeqMatchItem :: { SeqMatchItem } - : ForStepAssignment { Left $1 } - | Identifier "(" CallArgs ")" { Right ($1, $3) } + : ForStepAssignment { Left $1 } + | Identifier CallArgs { Right ($1, $2) } ActionBlock :: { ActionBlock } : Stmt %prec NoElse { ActionBlockIf $1 } @@ -879,22 +883,31 @@ Stmts :: { [Stmt] } | Stmts Stmt { $1 ++ [$2] } Stmt :: { Stmt } - : StmtNonAsgn { $1 } - | LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 } + : StmtAsgn { $1 } + | StmtNonAsgn { $1 } + +StmtAsgn :: { Stmt } + : LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 } + | LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") } + | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 } | Identifier ";" { Subroutine (Nothing) $1 (Args [] []) } | Identifier "::" Identifier ";" { Subroutine (Just $1) $3 (Args [] []) } - | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 } - | LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") } StmtNonAsgn :: { Stmt } + : StmtBlock(BlockKWSeq, "end" ) { $1 } + | StmtBlock(BlockKWPar, "join") { $1 } + | StmtNonBlock { $1 } + | Identifier ":" StmtNonBlock { Block Seq $1 [] [$3] } +StmtBlock(begin, end) :: { Stmt } + : begin StrTag DeclsAndStmts end StrTag { uncurry (Block $1 $ combineTags $2 $5) $3 } + | Identifier ":" begin DeclsAndStmts end StrTag { uncurry (Block $3 $ combineTags $1 $6) $4 } +StmtNonBlock :: { Stmt } : ";" { Null } - | "begin" opt(Tag) DeclsAndStmts "end" opt(Tag) { Block (combineTags $2 $5) (fst $3) (snd $3) } - | Unique "if" "(" Expr ")" Stmt "else" Stmt { If $1 $4 $6 $8 } - | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null } - | "for" "(" ";" opt(Expr) ";" ForStep ")" Stmt { For [] $4 $6 $8 } - | "for" "(" DeclTokens(";") opt(Expr) ";" ForStep ")" Stmt { For (parseDTsAsDeclsAndAsgns $3) $4 $6 $8 } - | Unique CaseKW "(" Expr ")" CasesWithDefault "endcase" { Case $1 $2 $4 (fst $6) (snd $6) } - | Identifier "(" CallArgs ")" ";" { Subroutine (Nothing) $1 $3 } - | Identifier "::" Identifier "(" CallArgs ")" ";" { Subroutine (Just $1) $3 $5 } + | Unique "if" "(" Expr ")" Stmt "else" Stmt { If $1 $4 $6 $8 } + | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null } + | "for" "(" ForInit ForCond ForStep ")" Stmt { For $3 $4 $5 $7 } + | Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 (fst $6) (snd $6) } + | Identifier CallArgs ";" { Subroutine (Nothing) $1 $2 } + | Identifier "::" Identifier CallArgs ";" { Subroutine (Just $1) $3 $4 } | TimingControl Stmt { Timing $1 $2 } | "return" Expr ";" { Return $2 } | "while" "(" Expr ")" Stmt { While $3 $5 } @@ -907,12 +920,25 @@ StmtNonAsgn :: { Stmt } | ProceduralAssertionStatement { Assertion $1 } | IncOrDecOperator LHS ";" { AsgnBlk (AsgnOp $1) $2 (Number "1") } +BlockKWPar :: { BlockKW } + : "fork" { Par } +BlockKWSeq :: { BlockKW } + : "begin" { Seq } + Unique :: { Maybe UniquePriority } : {- empty -} { Nothing } | "unique" { Just Unique } | "unique0" { Just Unique0 } | "priority" { Just Priority } +ForInit :: { Either [Decl] [(LHS, Expr)] } + : ";" { Right [] } + | DeclTokens(";") { parseDTsAsDeclsOrAsgns $1 } + +ForCond :: { Expr } + : ";" { Number "1" } + | Expr ";" { $1 } + ForStep :: { [(LHS, AsgnOp, Expr)] } : {- empty -} { [] } | ForStepNonEmpty { $1 } @@ -996,13 +1022,13 @@ CaseKW :: { CaseKW } | "casex" { CaseX } | "casez" { CaseZ } -CasesWithDefault :: { ([Case], Maybe Stmt) } - : {- empty -} { ([], Nothing) } - | Case CasesWithDefault { ($1 : fst $2, snd $2) } - | CaseDefault Cases { ($2, Just $1) } -Cases :: { [Case] } - : {- empty -} { [] } - | Cases Case { $1 ++ [$2] } +Cases :: { ([Case], Maybe Stmt) } + : {- empty -} { ([], Nothing) } + | Case Cases { ($1 : fst $2, snd $2) } + | CaseDefault CasesNoDefault { ($2, Just $1) } +CasesNoDefault :: { [Case] } + : {- empty -} { [] } + | CasesNoDefault Case { $1 ++ [$2] } Case :: { Case } : Exprs ":" Stmt { ($1, $3) } @@ -1020,6 +1046,8 @@ Time :: { String } : time { tokenString $1 } CallArgs :: { Args } + : "(" CallArgsInside ")" { $2 } +CallArgsInside :: { Args } : {- empty -} { Args [ ] [] } | NamedCallArgsFollow { Args [ ] $1 } | Expr NamedCallArgs { Args [Just $1 ] $2 } @@ -1049,8 +1077,8 @@ Expr :: { Expr } : "(" Expr ")" { $2 } | String { String $1 } | Number { Number $1 } - | Identifier "(" CallArgs ")" { Call (Nothing) $1 $3 } - | Identifier "::" Identifier "(" CallArgs ")" { Call (Just $1) $3 $5 } + | Identifier CallArgs { Call (Nothing) $1 $2 } + | Identifier "::" Identifier CallArgs { Call (Just $1) $3 $4 } | DimsFn "(" TypeOrExpr ")" { DimsFn $1 $3 } | DimFn "(" TypeOrExpr ")" { DimFn $1 $3 (Number "1") } | DimFn "(" TypeOrExpr "," Expr ")" { DimFn $1 $3 $5 } @@ -1156,8 +1184,8 @@ ConditionalGenerateConstruct :: { GenItem } LoopGenerateConstruct :: { GenItem } : "for" "(" GenvarInitialization ";" Expr ";" GenvarIteration ")" GenBlock { (uncurry $ GenFor $3 $5 $7) $9 } -GenBlock :: { (Maybe Identifier, [GenItem]) } - : "begin" opt(Tag) GenItems "end" opt(Tag) { (combineTags $2 $5, $3) } +GenBlock :: { (Identifier, [GenItem]) } + : "begin" StrTag GenItems "end" StrTag { (combineTags $2 $5, $3) } GenCasesWithDefault :: { ([GenCase], Maybe GenItem) } : {- empty -} { ([], Nothing) } @@ -1222,7 +1250,7 @@ parseError a = case a of genItemsToGenItem :: [GenItem] -> GenItem genItemsToGenItem [x] = x -genItemsToGenItem xs = GenBlock Nothing xs +genItemsToGenItem xs = GenBlock "" xs combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) -> ([Decl], [Stmt]) combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2) @@ -1242,13 +1270,13 @@ defaultFuncInput (Variable dir (Implicit sg rs) x a me) = else Implicit sg rs defaultFuncInput other = other -combineTags :: Maybe Identifier -> Maybe Identifier -> Maybe Identifier -combineTags (Just a) (Just b) = +combineTags :: Identifier -> Identifier -> Identifier +combineTags a "" = a +combineTags "" b = b +combineTags a b = if a == b - then Just a + then a else error $ "tag mismatch: " ++ show (a, b) -combineTags Nothing other = other -combineTags other _ = other toLHS :: Expr -> LHS toLHS expr = diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index 71e255c..d2cc208 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -35,7 +35,7 @@ module Language.SystemVerilog.Parser.ParseDecl , parseDTsAsDecls , parseDTsAsDecl , parseDTsAsDeclOrAsgn -, parseDTsAsDeclsAndAsgns +, parseDTsAsDeclsOrAsgns ) where import Data.List (elemIndex, findIndex, findIndices) @@ -219,28 +219,14 @@ parseDTsAsDeclOrAsgn tokens = isAsgn (DTAsgn _ _) = True isAsgn _ = False --- [PUBLIC]: parser for mixed comma-separated declaration and assignment lists; --- the main use case is for `for` loop initialization lists -parseDTsAsDeclsAndAsgns :: [DeclToken] -> [Either Decl (LHS, Expr)] -parseDTsAsDeclsAndAsgns [] = [] -parseDTsAsDeclsAndAsgns tokens = +-- [PUBLIC]: parser for comma-separated declarations or assignment lists; this +-- is only used for `for` loop initialization lists +parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)] +parseDTsAsDeclsOrAsgns tokens = + forbidNonEqAsgn tokens $ if hasLeadingAsgn || tripLookahead tokens - then - let (lhsToks, l0) = break isDTAsgn tokens - lhs = case takeLHS lhsToks of - Nothing -> - error $ "could not parse as LHS: " ++ show lhsToks - Just l -> l - DTAsgn AsgnOpEq expr : l1 = l0 - asgn = Right (lhs, expr) - in case l1 of - DTComma : remaining -> asgn : parseDTsAsDeclsAndAsgns remaining - [] -> [asgn] - _ -> error $ "bad decls and asgns tokens: " ++ show tokens - else - let (component, remaining) = parseDTsAsComponent tokens - decls = finalize component - in (map Left decls) ++ parseDTsAsDeclsAndAsgns remaining + then Right $ parseDTsAsAsgns tokens + else Left $ parseDTsAsDecls tokens where hasLeadingAsgn = -- if there is an asgn token before the next comma @@ -248,6 +234,22 @@ parseDTsAsDeclsAndAsgns tokens = (Just a, Just b) -> a > b (Nothing, Just _) -> True _ -> False + +-- internal parser for basic assignment lists +parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)] +parseDTsAsAsgns tokens = + case l1 of + [] -> [asgn] + DTComma : remaining -> asgn : parseDTsAsAsgns remaining + _ -> error $ "bad assignment tokens: " ++ show tokens + where + (lhsToks, l0) = break isDTAsgn tokens + lhs = case takeLHS lhsToks of + Nothing -> error $ "could not parse as LHS: " ++ show lhsToks + Just l -> l + DTAsgn AsgnOpEq expr : l1 = l0 + asgn = (lhs, expr) + isDTAsgn :: DeclToken -> Bool isDTAsgn (DTAsgn _ _) = True isDTAsgn _ = False