From fd4b0b5152f94cd406f2e5de86ce7ed0a4d2cbd0 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 2 Apr 2019 19:47:32 +0100 Subject: Large refactor with passing tests --- src/VeriFuzz/Verilog/AST.hs | 617 +++++++++++++++++++++++++++++++++++++ src/VeriFuzz/Verilog/CodeGen.hs | 293 ++++++++++++++++++ src/VeriFuzz/Verilog/Gen.hs | 202 ++++++++++++ src/VeriFuzz/Verilog/Internal.hs | 99 ++++++ src/VeriFuzz/Verilog/Lex.x | 187 +++++++++++ src/VeriFuzz/Verilog/Mutate.hs | 272 ++++++++++++++++ src/VeriFuzz/Verilog/Parser.hs | 316 +++++++++++++++++++ src/VeriFuzz/Verilog/Preprocess.hs | 108 +++++++ src/VeriFuzz/Verilog/Token.hs | 350 +++++++++++++++++++++ 9 files changed, 2444 insertions(+) create mode 100644 src/VeriFuzz/Verilog/AST.hs create mode 100644 src/VeriFuzz/Verilog/CodeGen.hs create mode 100644 src/VeriFuzz/Verilog/Gen.hs create mode 100644 src/VeriFuzz/Verilog/Internal.hs create mode 100644 src/VeriFuzz/Verilog/Lex.x create mode 100644 src/VeriFuzz/Verilog/Mutate.hs create mode 100644 src/VeriFuzz/Verilog/Parser.hs create mode 100644 src/VeriFuzz/Verilog/Preprocess.hs create mode 100644 src/VeriFuzz/Verilog/Token.hs (limited to 'src/VeriFuzz/Verilog') diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs new file mode 100644 index 0000000..405b712 --- /dev/null +++ b/src/VeriFuzz/Verilog/AST.hs @@ -0,0 +1,617 @@ +{-| +Module : VeriFuzz.Verilog.AST +Description : Definition of the Verilog AST types. +Copyright : (c) 2018-2019, Yann Herklotz +License : BSD-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Poratbility : POSIX + +Defines the types to build a Verilog AST. +-} + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} + +module VeriFuzz.Verilog.AST + ( -- * Top level types + Verilog(..) + , getVerilog + , Description(..) + , getDescription + -- * Primitives + -- ** Identifier + , Identifier(..) + , getIdentifier + -- ** Control + , Delay(..) + , getDelay + , Event(..) + -- ** Operators + , BinaryOperator(..) + , UnaryOperator(..) + -- ** Task + , Task(..) + , taskName + , taskExpr + -- ** Left hand side value + , LVal(..) + , regId + , regExprId + , regExpr + , regSizeId + , regSizeMSB + , regSizeLSB + , regConc + -- ** Ports + , PortDir(..) + , PortType(..) + , Port(..) + , portType + , portSigned + , portSize + , portName + -- * Expression + , Expr(..) + , exprSize + , exprVal + , exprId + , exprConcat + , exprUnOp + , exprPrim + , exprLhs + , exprBinOp + , exprRhs + , exprCond + , exprTrue + , exprFalse + , exprFunc + , exprBody + , exprStr + , exprWithContext + , traverseExpr + , ConstExpr(..) + , constNum + , Function(..) + -- * Assignment + , Assign(..) + , assignReg + , assignDelay + , assignExpr + , ContAssign(..) + , contAssignNetLVal + , contAssignExpr + -- * Statment + , Statement(..) + , statDelay + , statDStat + , statEvent + , statEStat + , statements + , stmntBA + , stmntNBA + , stmntCA + , stmntTask + , stmntSysTask + , stmntCondExpr + , stmntCondTrue + , stmntCondFalse + -- * Module + , ModDecl(..) + , modId + , modOutPorts + , modInPorts + , modItems + , ModItem(..) + , modContAssign + , modInstId + , modInstName + , modInstConns + , traverseModItem + , declDir + , declPort + , ModConn(..) + , modConn + , modConnName + , modExpr + -- * Useful Lenses and Traversals + , getModule + , getSourceId + -- * Arbitrary + , Arb + , arb + , genPositive + ) +where + +import Control.Lens +import Control.Monad (replicateM) +import Data.Data +import Data.Data.Lens +import Data.List.NonEmpty (toList) +import Data.String (IsString, fromString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Traversable (sequenceA) +import Hedgehog (Gen) +import qualified Hedgehog.Gen as Hog +import qualified Hedgehog.Range as Hog + +-- | Identifier in Verilog. This is just a string of characters that can either +-- be lowercase and uppercase for now. This might change in the future though, +-- as Verilog supports many more characters in Identifiers. +newtype Identifier = Identifier { _getIdentifier :: Text } + deriving (Eq, Show, Ord, Data, IsString, Semigroup, Monoid) + +-- | Verilog syntax for adding a delay, which is represented as @#num@. +newtype Delay = Delay { _getDelay :: Int } + deriving (Eq, Show, Ord, Data, Num) + +-- | Verilog syntax for an event, such as @\@x@, which is used for always blocks +data Event = EId {-# UNPACK #-} !Identifier + | EExpr !Expr + | EAll + | EPosEdge {-# UNPACK #-} !Identifier + | ENegEdge {-# UNPACK #-} !Identifier + deriving (Eq, Show, Ord, Data) + +-- | Binary operators that are currently supported in the verilog generation. +data BinaryOperator = BinPlus -- ^ @+@ + | BinMinus -- ^ @-@ + | BinTimes -- ^ @*@ + | BinDiv -- ^ @/@ + | BinMod -- ^ @%@ + | BinEq -- ^ @==@ + | BinNEq -- ^ @!=@ + | BinCEq -- ^ @===@ + | BinCNEq -- ^ @!==@ + | BinLAnd -- ^ @&&@ + | BinLOr -- ^ @||@ + | BinLT -- ^ @<@ + | BinLEq -- ^ @<=@ + | BinGT -- ^ @>@ + | BinGEq -- ^ @>=@ + | BinAnd -- ^ @&@ + | BinOr -- ^ @|@ + | BinXor -- ^ @^@ + | BinXNor -- ^ @^~@ + | BinXNorInv -- ^ @~^@ + | BinPower -- ^ @**@ + | BinLSL -- ^ @<<@ + | BinLSR -- ^ @>>@ + | BinASL -- ^ @<<<@ + | BinASR -- ^ @>>>@ + deriving (Eq, Show, Ord, Data) + +-- | Unary operators that are currently supported by the generator. +data UnaryOperator = UnPlus -- ^ @+@ + | UnMinus -- ^ @-@ + | UnLNot -- ^ @!@ + | UnNot -- ^ @~@ + | UnAnd -- ^ @&@ + | UnNand -- ^ @~&@ + | UnOr -- ^ @|@ + | UnNor -- ^ @~|@ + | UnXor -- ^ @^@ + | UnNxor -- ^ @~^@ + | UnNxorInv -- ^ @^~@ + deriving (Eq, Show, Ord, Data) + +data Function = SignedFunc + | UnSignedFunc + deriving (Eq, Show, Ord, Data) + +-- | Verilog expression, which can either be a primary expression, unary +-- expression, binary operator expression or a conditional expression. +data Expr = Number { _exprSize :: {-# UNPACK #-} !Int + , _exprVal :: Integer + } + | Id { _exprId :: {-# UNPACK #-} !Identifier } + | Concat { _exprConcat :: [Expr] } + | UnOp { _exprUnOp :: !UnaryOperator + , _exprPrim :: Expr + } + | BinOp { _exprLhs :: Expr + , _exprBinOp :: !BinaryOperator + , _exprRhs :: Expr + } + | Cond { _exprCond :: Expr + , _exprTrue :: Expr + , _exprFalse :: Expr + } + | Func { _exprFunc :: !Function + , _exprBody :: Expr + } + | Str { _exprStr :: {-# UNPACK #-} !Text } + deriving (Eq, Show, Ord, Data) + +instance Num Expr where + a + b = BinOp a BinPlus b + a - b = BinOp a BinMinus b + a * b = BinOp a BinTimes b + negate = UnOp UnMinus + abs = undefined + signum = undefined + fromInteger = Number 32 . fromInteger + +instance Semigroup Expr where + (Concat a) <> (Concat b) = Concat $ a <> b + (Concat a) <> b = Concat $ a <> [b] + a <> (Concat b) = Concat $ a : b + a <> b = Concat [a, b] + +instance Monoid Expr where + mempty = Concat [] + +instance IsString Expr where + fromString = Str . fromString + +instance Plated Expr where + plate = uniplate + +traverseExpr :: (Applicative f) => (Expr -> f Expr) -> Expr -> f Expr +traverseExpr f (Concat e ) = Concat <$> sequenceA (f <$> e) +traverseExpr f (UnOp u e ) = UnOp u <$> f e +traverseExpr f (BinOp l o r) = BinOp <$> f l <*> pure o <*> f r +traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r +traverseExpr f (Func fn e ) = Func fn <$> f e +traverseExpr _ e = pure e + +-- | Constant expression, which are known before simulation at compilation time. +newtype ConstExpr = ConstExpr { _constNum :: Int } + deriving (Eq, Show, Ord, Data, Num) + +data Task = Task { _taskName :: {-# UNPACK #-} !Identifier + , _taskExpr :: [Expr] + } deriving (Eq, Show, Ord, Data) + +-- | Type that represents the left hand side of an assignment, which can be a +-- concatenation such as in: +-- +-- @ +-- {a, b, c} = 32'h94238; +-- @ +data LVal = RegId { _regId :: {-# UNPACK #-} !Identifier } + | RegExpr { _regExprId :: {-# UNPACK #-} !Identifier + , _regExpr :: !Expr + } + | RegSize { _regSizeId :: {-# UNPACK #-} !Identifier + , _regSizeMSB :: !ConstExpr + , _regSizeLSB :: !ConstExpr + } + | RegConcat { _regConc :: [Expr] } + deriving (Eq, Show, Ord, Data) + +instance IsString LVal where + fromString = RegId . fromString + +-- | Different port direction that are supported in Verilog. +data PortDir = PortIn -- ^ Input direction for port (@input@). + | PortOut -- ^ Output direction for port (@output@). + | PortInOut -- ^ Inout direction for port (@inout@). + deriving (Eq, Show, Ord, Data) + +-- | Currently, only @wire@ and @reg@ are supported, as the other net types are +-- not that common and not a priority. +data PortType = Wire + | Reg + deriving (Eq, Show, Ord, Data) + +-- | Port declaration. It contains information about the type of the port, the +-- size, and the port name. It used to also contain information about if it was +-- an input or output port. However, this is not always necessary and was more +-- cumbersome than useful, as a lot of ports can be declared without input and +-- output port. +-- +-- This is now implemented inside 'ModDecl' itself, which uses a list of output +-- and input ports. +data Port = Port { _portType :: !PortType + , _portSigned :: !Bool + , _portSize :: {-# UNPACK #-} !Int + , _portName :: {-# UNPACK #-} !Identifier + } deriving (Eq, Show, Ord, Data) + +-- | This is currently a type because direct module declaration should also be +-- added: +-- +-- @ +-- mod a(.y(y1), .x1(x11), .x2(x22)); +-- @ +data ModConn = ModConn { _modConn :: !Expr } + | ModConnNamed { _modConnName :: {-# UNPACK #-} !Identifier + , _modExpr :: !Expr + } + deriving (Eq, Show, Ord, Data) + +data Assign = Assign { _assignReg :: !LVal + , _assignDelay :: !(Maybe Delay) + , _assignExpr :: !Expr + } deriving (Eq, Show, Ord, Data) + +data ContAssign = ContAssign { _contAssignNetLVal :: {-# UNPACK #-} !Identifier + , _contAssignExpr :: !Expr + } deriving (Eq, Show, Ord, Data) + +-- | Statements in Verilog. +data Statement = TimeCtrl { _statDelay :: {-# UNPACK #-} !Delay + , _statDStat :: Maybe Statement + } -- ^ Time control (@#NUM@) + | EventCtrl { _statEvent :: !Event + , _statEStat :: Maybe Statement + } + | SeqBlock { _statements :: [Statement] } -- ^ Sequential block (@begin ... end@) + | BlockAssign { _stmntBA :: !Assign } -- ^ blocking assignment (@=@) + | NonBlockAssign { _stmntNBA :: !Assign } -- ^ Non blocking assignment (@<=@) + | StatCA { _stmntCA :: !ContAssign } -- ^ Statement continuous assignment. May not be correct. + | TaskEnable { _stmntTask :: !Task } + | SysTaskEnable { _stmntSysTask :: !Task } + | CondStmnt { _stmntCondExpr :: Expr + , _stmntCondTrue :: Maybe Statement + , _stmntCondFalse :: Maybe Statement + } + deriving (Eq, Show, Ord, Data) + +instance Semigroup Statement where + (SeqBlock a) <> (SeqBlock b) = SeqBlock $ a <> b + (SeqBlock a) <> b = SeqBlock $ a <> [b] + a <> (SeqBlock b) = SeqBlock $ a : b + a <> b = SeqBlock [a, b] + +instance Monoid Statement where + mempty = SeqBlock [] + +-- | Module item which is the body of the module expression. +data ModItem = ModCA { _modContAssign :: !ContAssign } + | ModInst { _modInstId :: {-# UNPACK #-} !Identifier + , _modInstName :: {-# UNPACK #-} !Identifier + , _modInstConns :: [ModConn] + } + | Initial !Statement + | Always !Statement + | Decl { _declDir :: !(Maybe PortDir) + , _declPort :: !Port + } + deriving (Eq, Show, Ord, Data) + +-- | 'module' module_identifier [list_of_ports] ';' { module_item } 'end_module' +data ModDecl = ModDecl { _modId :: {-# UNPACK #-} !Identifier + , _modOutPorts :: [Port] + , _modInPorts :: [Port] + , _modItems :: [ModItem] + } deriving (Eq, Show, Ord, Data) + +traverseModConn :: (Applicative f) => (Expr -> f Expr) -> ModConn -> f ModConn +traverseModConn f (ModConn e ) = ModConn <$> f e +traverseModConn f (ModConnNamed a e) = ModConnNamed a <$> f e + +traverseModItem :: (Applicative f) => (Expr -> f Expr) -> ModItem -> f ModItem +traverseModItem f (ModCA (ContAssign a e)) = ModCA . ContAssign a <$> f e +traverseModItem f (ModInst a b e) = + ModInst a b <$> sequenceA (traverseModConn f <$> e) +traverseModItem _ e = pure e + +-- | Description of the Verilog module. +newtype Description = Description { _getDescription :: ModDecl } + deriving (Eq, Show, Ord, Data) + +-- | The complete sourcetext for the Verilog module. +newtype Verilog = Verilog { _getVerilog :: [Description] } + deriving (Eq, Show, Ord, Data, Semigroup, Monoid) + +makeLenses ''Identifier +makeLenses ''Delay +makeLenses ''Expr +makeLenses ''ConstExpr +makeLenses ''Task +makeLenses ''LVal +makeLenses ''PortType +makeLenses ''Port +makeLenses ''ModConn +makeLenses ''Assign +makeLenses ''ContAssign +makeLenses ''Statement +makeLenses ''ModItem +makeLenses ''ModDecl +makeLenses ''Description +makeLenses ''Verilog + +getModule :: Traversal' Verilog ModDecl +getModule = getVerilog . traverse . getDescription +{-# INLINE getModule #-} + +getSourceId :: Traversal' Verilog Text +getSourceId = getModule . modId . getIdentifier +{-# INLINE getSourceId #-} + +listOf1 :: Gen a -> Gen [a] +listOf1 a = toList <$> Hog.nonEmpty (Hog.linear 0 100) a + +listOf :: Gen a -> Gen [a] +listOf = Hog.list (Hog.linear 0 100) + +genPositive :: Gen Int +genPositive = Hog.filter (>= 0) $ Hog.int (Hog.linear 1 99) + +integral :: Gen Integer +integral = Hog.integral (Hog.linear 0 100) + +class Arb a where + arb :: Gen a + +instance Arb Identifier where + arb = do + l <- genPositive + Identifier . T.pack <$> replicateM (l + 1) (Hog.element ['a'..'z']) + +instance Arb Delay where + arb = Delay <$> genPositive + +instance Arb Event where + arb = EId <$> arb + +instance Arb BinaryOperator where + arb = Hog.element + [ BinPlus + , BinMinus + , BinTimes + -- , BinDiv + -- , BinMod + , BinEq + , BinNEq + -- , BinCEq + -- , BinCNEq + , BinLAnd + , BinLOr + , BinLT + , BinLEq + , BinGT + , BinGEq + , BinAnd + , BinOr + , BinXor + , BinXNor + , BinXNorInv + -- , BinPower + , BinLSL + , BinLSR + , BinASL + , BinASR + ] + +instance Arb UnaryOperator where + arb = Hog.element + [ UnPlus + , UnMinus + , UnNot + , UnLNot + , UnAnd + , UnNand + , UnOr + , UnNor + , UnXor + , UnNxor + , UnNxorInv + ] + +instance Arb Function where + arb = Hog.element + [ SignedFunc + , UnSignedFunc + ] + +instance Arb Expr where + arb = Hog.sized expr + +exprSafeList :: [Gen Expr] +exprSafeList = [Number <$> genPositive <*> integral] + +exprRecList :: (Hog.Size -> Gen Expr) -> [Gen Expr] +exprRecList subexpr = + [ Number <$> genPositive <*> integral + , Concat <$> listOf1 (subexpr 8) + , UnOp + <$> arb + <*> subexpr 2 + -- , Str <$> arb + , BinOp <$> subexpr 2 <*> arb <*> subexpr 2 + , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 + , Func <$> arb <*> subexpr 2 + ] + +expr :: Hog.Size -> Gen Expr +expr n | n == 0 = Hog.choice $ (Id <$> arb) : exprSafeList + | n > 0 = Hog.choice $ (Id <$> arb) : exprRecList subexpr + | otherwise = expr 0 + where subexpr y = expr (n `div` y) + +exprWithContext :: [Identifier] -> Hog.Size -> Gen Expr +exprWithContext [] n | n == 0 = Hog.choice exprSafeList + | n > 0 = Hog.choice $ exprRecList subexpr + | otherwise = exprWithContext [] 0 + where subexpr y = exprWithContext [] (n `div` y) +exprWithContext l n + | n == 0 = Hog.choice $ (Id <$> Hog.element l) : exprSafeList + | n > 0 = Hog.choice $ (Id <$> Hog.element l) : exprRecList subexpr + | otherwise = exprWithContext l 0 + where subexpr y = exprWithContext l (n `div` y) + +instance Arb Int where + arb = Hog.int (Hog.linear 0 100) + +instance Arb ConstExpr where + arb = ConstExpr <$> Hog.int (Hog.linear 0 100) + +instance Arb Task where + arb = Task <$> arb <*> listOf arb + +instance Arb LVal where + arb = Hog.choice [ RegId <$> arb + , RegExpr <$> arb <*> arb + , RegSize <$> arb <*> arb <*> arb + ] + +instance Arb PortDir where + arb = Hog.element [PortIn, PortOut, PortInOut] + +instance Arb PortType where + arb = Hog.element [Wire, Reg] + +instance Arb Port where + arb = Port <$> arb <*> arb <*> genPositive <*> arb + +instance Arb ModConn where + arb = ModConn <$> arb + +instance Arb Assign where + arb = Assign <$> arb <*> Hog.maybe arb <*> arb + +instance Arb ContAssign where + arb = ContAssign <$> arb <*> arb + +instance Arb Statement where + arb = Hog.sized statement + +statement :: Hog.Size -> Gen Statement +statement n + | n == 0 = Hog.choice + [ BlockAssign <$> arb + , NonBlockAssign <$> arb + -- , StatCA <$> arb + , TaskEnable <$> arb + , SysTaskEnable <$> arb + ] + | n > 0 = Hog.choice + [ TimeCtrl <$> arb <*> (Just <$> substat 2) + , SeqBlock <$> listOf1 (substat 4) + , BlockAssign <$> arb + , NonBlockAssign <$> arb + -- , StatCA <$> arb + , TaskEnable <$> arb + , SysTaskEnable <$> arb + ] + | otherwise = statement 0 + where substat y = statement (n `div` y) + +instance Arb ModItem where + arb = Hog.choice [ ModCA <$> arb + , ModInst <$> arb <*> arb <*> listOf arb + , Initial <$> arb + , Always <$> (EventCtrl <$> arb <*> Hog.maybe arb) + , Decl <$> pure Nothing <*> arb + ] + +modPortGen :: Gen Port +modPortGen = Port <$> arb <*> arb <*> arb <*> arb + +instance Arb ModDecl where + arb = ModDecl <$> arb <*> listOf arb <*> listOf1 modPortGen <*> listOf arb + +instance Arb Description where + arb = Description <$> arb + +instance Arb Verilog where + arb = Verilog <$> listOf1 arb + +instance Arb Bool where + arb = Hog.element [True, False] diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs new file mode 100644 index 0000000..eb3b3d1 --- /dev/null +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -0,0 +1,293 @@ +{-| +Module : VeriFuzz.Verilog.CodeGen +Description : Code generation for Verilog AST. +Copyright : (c) 2018-2019, Yann Herklotz +License : BSD-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +This module generates the code from the Verilog AST defined in +"VeriFuzz.Verilog.AST". +-} + +{-# LANGUAGE FlexibleInstances #-} + +module VeriFuzz.Verilog.CodeGen + ( -- * Code Generation + GenVerilog(..) + , genSource + , render + ) +where + +import Control.Lens (view, (^.)) +import Data.Foldable (fold) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Numeric (showHex) +import VeriFuzz.Internal +import VeriFuzz.Sim.Internal +import VeriFuzz.Verilog.AST + +-- | 'Source' class which determines that source code is able to be generated +-- from the data structure using 'genSource'. This will be stored in 'Text' and +-- can then be processed further. +class Source a where + genSource :: a -> Text + +-- | Map a 'Maybe Statement' to 'Text'. If it is 'Just statement', the generated +-- statements are returned. If it is 'Nothing', then @;\n@ is returned. +defMap :: Maybe Statement -> Text +defMap = maybe ";\n" statement + +-- | Convert the 'Verilog' type to 'Text' so that it can be rendered. +verilogSrc :: Verilog -> Text +verilogSrc source = fold $ description <$> source ^. getVerilog + +-- | Generate the 'Description' to 'Text'. +description :: Description -> Text +description desc = moduleDecl $ desc ^. getDescription + +-- | Generate the 'ModDecl' for a module and convert it to 'Text'. +moduleDecl :: ModDecl -> Text +moduleDecl m = + "module " + <> m + ^. modId + . getIdentifier + <> ports + <> ";\n" + <> modI + <> "endmodule\n" + where + ports | noIn && noOut = "" + | otherwise = "(" <> comma (modPort <$> outIn) <> ")" + modI = fold $ moduleItem <$> m ^. modItems + noOut = null $ m ^. modOutPorts + noIn = null $ m ^. modInPorts + outIn = (m ^. modOutPorts) ++ (m ^. modInPorts) + +-- | Conversts 'Port' to 'Text' for the module list, which means it only +-- generates a list of identifiers. +modPort :: Port -> Text +modPort p = p ^. portName . getIdentifier + +-- | Generate the 'Port' description. +port :: Port -> Text +port p = t <> sign <> size <> name + where + t = flip mappend " " . pType $ p ^. portType + size | p ^. portSize > 1 = "[" <> showT (p ^. portSize - 1) <> ":0] " + | otherwise = "" + name = p ^. portName . getIdentifier + sign = signed $ p ^. portSigned + +signed :: Bool -> Text +signed True = "signed " +signed _ = "" + +-- | Convert the 'PortDir' type to 'Text'. +portDir :: PortDir -> Text +portDir PortIn = "input" +portDir PortOut = "output" +portDir PortInOut = "inout" + +-- | Generate a 'ModItem'. +moduleItem :: ModItem -> Text +moduleItem (ModCA ca) = contAssign ca +moduleItem (ModInst (Identifier i) (Identifier name) conn) = + i <> " " <> name <> "(" <> comma (mConn <$> conn) <> ")" <> ";\n" +moduleItem (Initial stat) = "initial " <> statement stat +moduleItem (Always stat) = "always " <> statement stat +moduleItem (Decl dir p ) = maybe "" makePort dir <> port p <> ";\n" + where makePort = (<> " ") . portDir + +mConn :: ModConn -> Text +mConn (ModConn c ) = expr c +mConn (ModConnNamed n c) = "." <> n ^. getIdentifier <> "(" <> expr c <> ")" + +-- | Generate continuous assignment +contAssign :: ContAssign -> Text +contAssign (ContAssign val e) = + "assign " <> val ^. getIdentifier <> " = " <> expr e <> ";\n" + +-- | Generate 'Function' to 'Text' +func :: Function -> Text +func SignedFunc = "$signed" +func UnSignedFunc = "$unsigned" + +-- | Generate 'Expr' to 'Text'. +expr :: Expr -> Text +expr (BinOp eRhs bin eLhs) = + "(" <> expr eRhs <> binaryOp bin <> expr eLhs <> ")" +expr (Number s n) = + "(" <> minus <> showT s <> "'h" <> T.pack (showHex (abs n) "") <> ")" + where + minus | signum n >= 0 = "" + | otherwise = "-" +expr (Id i ) = i ^. getIdentifier +expr (Concat c ) = "{" <> comma (expr <$> c) <> "}" +expr (UnOp u e ) = "(" <> unaryOp u <> expr e <> ")" +expr (Cond l t f) = "(" <> expr l <> " ? " <> expr t <> " : " <> expr f <> ")" +expr (Func f e ) = func f <> "(" <> expr e <> ")" +expr (Str t ) = "\"" <> t <> "\"" + +-- | Convert 'BinaryOperator' to 'Text'. +binaryOp :: BinaryOperator -> Text +binaryOp BinPlus = " + " +binaryOp BinMinus = " - " +binaryOp BinTimes = " * " +binaryOp BinDiv = " / " +binaryOp BinMod = " % " +binaryOp BinEq = " == " +binaryOp BinNEq = " != " +binaryOp BinCEq = " === " +binaryOp BinCNEq = " !== " +binaryOp BinLAnd = " && " +binaryOp BinLOr = " || " +binaryOp BinLT = " < " +binaryOp BinLEq = " <= " +binaryOp BinGT = " > " +binaryOp BinGEq = " >= " +binaryOp BinAnd = " & " +binaryOp BinOr = " | " +binaryOp BinXor = " ^ " +binaryOp BinXNor = " ^~ " +binaryOp BinXNorInv = " ~^ " +binaryOp BinPower = " ** " +binaryOp BinLSL = " << " +binaryOp BinLSR = " >> " +binaryOp BinASL = " <<< " +binaryOp BinASR = " >>> " + +-- | Convert 'UnaryOperator' to 'Text'. +unaryOp :: UnaryOperator -> Text +unaryOp UnPlus = "+" +unaryOp UnMinus = "-" +unaryOp UnLNot = "!" +unaryOp UnNot = "~" +unaryOp UnAnd = "&" +unaryOp UnNand = "~&" +unaryOp UnOr = "|" +unaryOp UnNor = "~|" +unaryOp UnXor = "^" +unaryOp UnNxor = "~^" +unaryOp UnNxorInv = "^~" + +-- | Generate verilog code for an 'Event'. +event :: Event -> Text +event (EId i) = "@(" <> i ^. getIdentifier <> ")" +event (EExpr e) = "@(" <> expr e <> ")" +event EAll = "@*" +event (EPosEdge i) = "@(posedge " <> i ^. getIdentifier <> ")" +event (ENegEdge i) = "@(negedge " <> i ^. getIdentifier <> ")" + +-- | Generates verilog code for a 'Delay'. +delay :: Delay -> Text +delay (Delay i) = "#" <> showT i + +-- | Generate the verilog code for an 'LVal'. +lVal :: LVal -> Text +lVal (RegId i ) = i ^. getIdentifier +lVal (RegExpr i e) = i ^. getIdentifier <> " [" <> expr e <> "]" +lVal (RegSize i msb lsb) = + i ^. getIdentifier <> " [" <> constExpr msb <> ":" <> constExpr lsb <> "]" +lVal (RegConcat e) = "{" <> comma (expr <$> e) <> "}" + +constExpr :: ConstExpr -> Text +constExpr (ConstExpr num) = showT num + +pType :: PortType -> Text +pType Wire = "wire" +pType Reg = "reg" + +genAssign :: Text -> Assign -> Text +genAssign op (Assign r d e) = lVal r <> op <> maybe "" delay d <> expr e + +statement :: Statement -> Text +statement (TimeCtrl d stat ) = delay d <> " " <> defMap stat +statement (EventCtrl e stat ) = event e <> " " <> defMap stat +statement (SeqBlock s) = "begin\n" <> fold (statement <$> s) <> "end\n" +statement (BlockAssign a ) = genAssign " = " a <> ";\n" +statement (NonBlockAssign a ) = genAssign " <= " a <> ";\n" +statement (StatCA a ) = contAssign a +statement (TaskEnable t ) = task t <> ";\n" +statement (SysTaskEnable t ) = "$" <> task t <> ";\n" +statement (CondStmnt e t Nothing) = "if(" <> expr e <> ")" <> defMap t +statement (CondStmnt e t f) = + "if(" <> expr e <> ") " <> defMap t <> "else " <> defMap f + +task :: Task -> Text +task (Task name e) | null e = i + | otherwise = i <> "(" <> comma (expr <$> e) <> ")" + where i = name ^. getIdentifier + +-- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. +render :: (Source a) => a -> IO () +render = T.putStrLn . genSource + +-- Instances + +instance Source Identifier where + genSource = view getIdentifier + +instance Source Task where + genSource = task + +instance Source Statement where + genSource = statement + +instance Source PortType where + genSource = pType + +instance Source ConstExpr where + genSource = constExpr + +instance Source LVal where + genSource = lVal + +instance Source Delay where + genSource = delay + +instance Source Event where + genSource = event + +instance Source UnaryOperator where + genSource = unaryOp + +instance Source Expr where + genSource = expr + +instance Source ContAssign where + genSource = contAssign + +instance Source ModItem where + genSource = moduleItem + +instance Source PortDir where + genSource = portDir + +instance Source Port where + genSource = port + +instance Source ModDecl where + genSource = moduleDecl + +instance Source Description where + genSource = description + +instance Source Verilog where + genSource = verilogSrc + +newtype GenVerilog a = GenVerilog { unGenVerilog :: a } + +instance (Source a) => Show (GenVerilog a) where + show = T.unpack . genSource . unGenVerilog + +instance (Arb a) => Arb (GenVerilog a) where + arb = GenVerilog <$> arb + +instance Source SourceInfo where + genSource (SourceInfo _ src) = genSource src diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs new file mode 100644 index 0000000..3d508c6 --- /dev/null +++ b/src/VeriFuzz/Verilog/Gen.hs @@ -0,0 +1,202 @@ +{-| +Module : VeriFuzz.Verilog.Gen +Description : Various useful generators. +Copyright : (c) 2019, Yann Herklotz +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Various useful generators. +-} + +{-# LANGUAGE TemplateHaskell #-} + +module VeriFuzz.Verilog.Gen + ( -- * Generation methods + procedural + , randomMod + ) +where + +import Control.Lens hiding (Context) +import Control.Monad (replicateM) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Reader hiding (local) +import Control.Monad.Trans.State.Lazy +import Data.Foldable (fold) +import qualified Data.Text as T +import Hedgehog (Gen) +import qualified Hedgehog.Gen as Hog +import VeriFuzz.Config +import VeriFuzz.Internal +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.Internal +import VeriFuzz.Verilog.Mutate + +data Context = Context { _variables :: [Port] + , _nameCounter :: Int + , _stmntDepth :: Int + } + +makeLenses ''Context + +type StateGen = StateT Context (ReaderT Config Gen) + +toId :: Int -> Identifier +toId = Identifier . ("w" <>) . T.pack . show + +toPort :: Identifier -> Gen Port +toPort ident = do + i <- genPositive + return $ wire i ident + +sumSize :: [Port] -> Int +sumSize ps = sum $ ps ^.. traverse . portSize + +random :: [Identifier] -> (Expr -> ContAssign) -> Gen ModItem +random ctx fun = do + expr <- Hog.sized (exprWithContext ctx) + return . ModCA $ fun expr + +--randomAssigns :: [Identifier] -> [Gen ModItem] +--randomAssigns ids = random ids . ContAssign <$> ids + +randomOrdAssigns :: [Identifier] -> [Identifier] -> [Gen ModItem] +randomOrdAssigns inp ids = snd $ foldr generate (inp, []) ids + where generate cid (i, o) = (cid : i, random i (ContAssign cid) : o) + +randomMod :: Int -> Int -> Gen ModDecl +randomMod inps total = do + x <- sequence $ randomOrdAssigns start end + ident <- sequence $ toPort <$> ids + let inputs_ = take inps ident + let other = drop inps ident + let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids + let yport = [wire (sumSize other) "y"] + return . declareMod other . ModDecl "test_module" yport inputs_ $ x ++ [y] + where + ids = toId <$> [1 .. total] + end = drop inps ids + start = take inps ids + +gen :: Gen a -> StateGen a +gen = lift . lift + +some :: StateGen a -> StateGen [a] +some f = do + amount <- gen genPositive + replicateM amount f + +makeIdentifier :: T.Text -> StateGen Identifier +makeIdentifier prefix = do + context <- get + let ident = Identifier $ prefix <> showT (context ^. nameCounter) + nameCounter += 1 + return ident + +newPort :: PortType -> StateGen Port +newPort pt = do + ident <- makeIdentifier . T.toLower $ showT pt + p <- gen $ Port pt <$> arb <*> genPositive <*> pure ident + variables %= (p :) + return p + +select :: PortType -> StateGen Port +select ptype = do + context <- get + case filter chooseReg $ context ^.. variables . traverse of + [] -> newPort ptype + l -> gen $ Hog.element l + where chooseReg (Port a _ _ _) = ptype == a + +scopedExpr :: StateGen Expr +scopedExpr = do + context <- get + gen + . Hog.sized + . exprWithContext + $ context + ^.. variables + . traverse + . portName + +contAssign :: StateGen ContAssign +contAssign = do + p <- newPort Wire + ContAssign (p ^. portName) <$> scopedExpr + +lvalFromPort :: Port -> LVal +lvalFromPort (Port _ _ _ i) = RegId i + +probability :: Config -> Probability +probability c = c ^. configProbability + +askProbability :: StateGen Probability +askProbability = lift $ asks probability + +assignment :: StateGen Assign +assignment = do + expr <- scopedExpr + lval <- lvalFromPort <$> newPort Reg + return $ Assign lval Nothing expr + +conditional :: StateGen Statement +conditional = do + expr <- scopedExpr + stmntDepth -= 1 + tstat <- SeqBlock <$> some statement + stmntDepth += 1 + return $ CondStmnt expr (Just tstat) Nothing + +statement :: StateGen Statement +statement = do + prob <- askProbability + cont <- get + Hog.frequency + [ (prob ^. probBlock , BlockAssign <$> assignment) + , (prob ^. probNonBlock , NonBlockAssign <$> assignment) + , (onDepth cont (prob ^. probCond), conditional) + ] + where onDepth c n = if c ^. stmntDepth > 0 then n else 0 + +-- | Generate a random module item. +modItem :: StateGen ModItem +modItem = do + prob <- askProbability + stat <- fold <$> some statement + eventReg <- select Reg + modCA <- ModCA <$> contAssign + gen $ Hog.frequency + [ (prob ^. probAssign, return modCA) + , ( prob ^. probAlways + , return $ Always (EventCtrl (EId (eventReg ^. portName)) (Just stat)) + ) + ] + +-- | Generates a module definition randomly. It always has one output port which +-- is set to @y@. The size of @y@ is the total combination of all the locally +-- defined wires, so that it correctly reflects the internal state of the +-- module. +moduleDef :: Bool -> StateGen ModDecl +moduleDef top = do + name <- if top then return "top" else gen arb + portList <- some $ newPort Wire + mi <- some modItem + context <- get + let local = filter (`notElem` portList) $ context ^. variables + let size = sum $ local ^.. traverse . portSize + let yport = Port Wire False size "y" + return . declareMod local . ModDecl name [yport] portList $ combineAssigns + yport + mi + +-- | Procedural generation method for random Verilog. Uses internal 'Reader' and +-- 'State' to keep track of the current Verilog code structure. +procedural :: Config -> Gen Verilog +procedural config = Verilog . (: []) . Description <$> Hog.resize + num + (runReaderT (evalStateT (moduleDef True) context) config) + where + context = Context [] 0 $ config ^. configProperty . propDepth + num = fromIntegral $ config ^. configProperty . propSize diff --git a/src/VeriFuzz/Verilog/Internal.hs b/src/VeriFuzz/Verilog/Internal.hs new file mode 100644 index 0000000..5999a31 --- /dev/null +++ b/src/VeriFuzz/Verilog/Internal.hs @@ -0,0 +1,99 @@ +{-| +Module : VeriFuzz.Verilog.Internal +Description : Defaults and common functions. +Copyright : (c) 2018-2019, Yann Herklotz +License : BSD-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Defaults and common functions. +-} + +module VeriFuzz.Verilog.Internal + ( regDecl + , wireDecl + , emptyMod + , setModName + , addModPort + , addDescription + , testBench + , addTestBench + , defaultPort + , portToExpr + , modName + , yPort + , wire + , reg + ) +where + +import Control.Lens +import Data.Text (Text) +import VeriFuzz.Verilog.AST + +regDecl :: Identifier -> ModItem +regDecl = Decl Nothing . Port Reg False 1 + +wireDecl :: Identifier -> ModItem +wireDecl = Decl Nothing . Port Wire False 1 + +-- | Create an empty module. +emptyMod :: ModDecl +emptyMod = ModDecl "" [] [] [] + +-- | Set a module name for a module declaration. +setModName :: Text -> ModDecl -> ModDecl +setModName str = modId .~ Identifier str + +-- | Add a input port to the module declaration. +addModPort :: Port -> ModDecl -> ModDecl +addModPort port = modInPorts %~ (:) port + +addDescription :: Description -> Verilog -> Verilog +addDescription desc = getVerilog %~ (:) desc + +testBench :: ModDecl +testBench = ModDecl + "main" + [] + [] + [ regDecl "a" + , regDecl "b" + , wireDecl "c" + , ModInst "and" + "and_gate" + [ModConn $ Id "c", ModConn $ Id "a", ModConn $ Id "b"] + , Initial $ SeqBlock + [ BlockAssign . Assign (RegId "a") Nothing $ Number 1 1 + , BlockAssign . Assign (RegId "b") Nothing $ Number 1 1 + -- , TimeCtrl (Delay 1) . Just . SysTaskEnable $ Task "display" + -- [ Str "%d & %d = %d" + -- , PrimExpr $ PrimId "a" + -- , PrimExpr $ PrimId "b" + -- , PrimExpr $ PrimId "c" + -- ] + -- , SysTaskEnable $ Task "finish" [] + ] + ] + +addTestBench :: Verilog -> Verilog +addTestBench = addDescription $ Description testBench + +defaultPort :: Identifier -> Port +defaultPort = Port Wire False 1 + +portToExpr :: Port -> Expr +portToExpr (Port _ _ _ i) = Id i + +modName :: ModDecl -> Text +modName = view $ modId . getIdentifier + +yPort :: Identifier -> Port +yPort = Port Wire False 90 + +wire :: Int -> Identifier -> Port +wire = Port Wire False + +reg :: Int -> Identifier -> Port +reg = Port Reg False diff --git a/src/VeriFuzz/Verilog/Lex.x b/src/VeriFuzz/Verilog/Lex.x new file mode 100644 index 0000000..2e99698 --- /dev/null +++ b/src/VeriFuzz/Verilog/Lex.x @@ -0,0 +1,187 @@ +{ +{-# OPTIONS_GHC -w #-} +module VeriFuzz.Verilog.Lex + ( alexScanTokens + ) where + +import VeriFuzz.Verilog.Token + +} + +%wrapper "posn" + +-- Numbers + +$nonZeroDecimalDigit = [1-9] +$decimalDigit = [0-9] +@binaryDigit = [0-1] +@octalDigit = [0-7] +@hexDigit = [0-9a-fA-F] + +@decimalBase = "'" [dD] +@binaryBase = "'" [bB] +@octalBase = "'" [oO] +@hexBase = "'" [hH] + +@binaryValue = @binaryDigit ("_" | @binaryDigit)* +@octalValue = @octalDigit ("_" | @octalDigit)* +@hexValue = @hexDigit ("_" | @hexDigit)* + +@unsignedNumber = $decimalDigit ("_" | $decimalDigit)* + +@size = @unsignedNumber + +@decimalNumber + = @unsignedNumber + | @size? @decimalBase @unsignedNumber + +@binaryNumber = @size? @binaryBase @binaryValue +@octalNumber = @size? @octalBase @octalValue +@hexNumber = @size? @hexBase @hexValue + +-- $exp = [eE] +-- $sign = [\+\-] +-- @realNumber = unsignedNumber "." unsignedNumber | unsignedNumber ( "." unsignedNumber)? exp sign? unsignedNumber +@number = @decimalNumber | @octalNumber | @binaryNumber | @hexNumber + +-- Strings + +@string = \" [^\r\n]* \" + +-- Identifiers + +@escapedIdentifier = "\" ($printable # $white)+ $white +@simpleIdentifier = [a-zA-Z_] [a-zA-Z0-9_\$]* +@systemIdentifier = "$" [a-zA-Z0-9_\$]+ + + +tokens :- + + "always" { tok KWAlways } + "assign" { tok KWAssign } + "begin" { tok KWBegin } + "case" { tok KWCase } + "default" { tok KWDefault } + "else" { tok KWElse } + "end" { tok KWEnd } + "endcase" { tok KWEndcase } + "endmodule" { tok KWEndmodule } + "for" { tok KWFor } + "if" { tok KWIf } + "initial" { tok KWInitial } + "inout" { tok KWInout } + "input" { tok KWInput } + "integer" { tok KWInteger } + "localparam" { tok KWLocalparam } + "module" { tok KWModule } + "negedge" { tok KWNegedge } + "or" { tok KWOr } + "output" { tok KWOutput } + "parameter" { tok KWParameter } + "posedge" { tok KWPosedge } + "reg" { tok KWReg } + "wire" { tok KWWire } + "signed" { tok KWSigned } + + @simpleIdentifier { tok IdSimple } + @escapedIdentifier { tok IdEscaped } + @systemIdentifier { tok IdSystem } + + @number { tok LitNumber } + @string { tok LitString } + + "(" { tok SymParenL } + ")" { tok SymParenR } + "[" { tok SymBrackL } + "]" { tok SymBrackR } + "{" { tok SymBraceL } + "}" { tok SymBraceR } + "~" { tok SymTildy } + "!" { tok SymBang } + "@" { tok SymAt } + "#" { tok SymPound } + "%" { tok SymPercent } + "^" { tok SymHat } + "&" { tok SymAmp } + "|" { tok SymBar } + "*" { tok SymAster } + "." { tok SymDot } + "," { tok SymComma } + ":" { tok SymColon } + ";" { tok SymSemi } + "=" { tok SymEq } + "<" { tok SymLt } + ">" { tok SymGt } + "+" { tok SymPlus } + "-" { tok SymDash } + "?" { tok SymQuestion } + "/" { tok SymSlash } + "$" { tok SymDollar } + "'" { tok SymSQuote } + + "~&" { tok SymTildyAmp } + "~|" { tok SymTildyBar } + "~^" { tok SymTildyHat } + "^~" { tok SymHatTildy } + "==" { tok SymEqEq } + "!=" { tok SymBangEq } + "&&" { tok SymAmpAmp } + "||" { tok SymBarBar } + "**" { tok SymAsterAster } + "<=" { tok SymLtEq } + ">=" { tok SymGtEq } + ">>" { tok SymGtGt } + "<<" { tok SymLtLt } + "++" { tok SymPlusPlus } + "--" { tok SymDashDash } + "+=" { tok SymPlusEq } + "-=" { tok SymDashEq } + "*=" { tok SymAsterEq } + "/=" { tok SymSlashEq } + "%=" { tok SymPercentEq } + "&=" { tok SymAmpEq } + "|=" { tok SymBarEq } + "^=" { tok SymHatEq } + "+:" { tok SymPlusColon } + "-:" { tok SymDashColon } + "::" { tok SymColonColon } + ".*" { tok SymDotAster } + "->" { tok SymDashGt } + ":=" { tok SymColonEq } + ":/" { tok SymColonSlash } + "##" { tok SymPoundPound } + "[*" { tok SymBrackLAster } + "[=" { tok SymBrackLEq } + "=>" { tok SymEqGt } + "@*" { tok SymAtAster } + "(*" { tok SymParenLAster } + "*)" { tok SymAsterParenR } + "*>" { tok SymAsterGt } + + "===" { tok SymEqEqEq } + "!==" { tok SymBangEqEq } + "=?=" { tok SymEqQuestionEq } + "!?=" { tok SymBangQuestionEq } + ">>>" { tok SymGtGtGt } + "<<<" { tok SymLtLtLt } + "<<=" { tok SymLtLtEq } + ">>=" { tok SymGtGtEq } + "|->" { tok SymBarDashGt } + "|=>" { tok SymBarEqGt } + "[->" { tok SymBrackLDashGt } + "@@(" { tok SymAtAtParenL } + "(*)" { tok SymParenLAsterParenR } + "->>" { tok SymDashGtGt } + "&&&" { tok SymAmpAmpAmp } + + "<<<=" { tok SymLtLtLtEq } + ">>>=" { tok SymGtGtGtEq } + + $white ; + + . { tok Unknown } + +{ +tok :: TokenName -> AlexPosn -> String -> Token +tok t (AlexPn _ l c) s = Token t s $ Position "" l c +} diff --git a/src/VeriFuzz/Verilog/Mutate.hs b/src/VeriFuzz/Verilog/Mutate.hs new file mode 100644 index 0000000..c72463f --- /dev/null +++ b/src/VeriFuzz/Verilog/Mutate.hs @@ -0,0 +1,272 @@ +{-| +Module : VeriFuzz.Verilog.Mutate +Description : Functions to mutate the Verilog AST. +Copyright : (c) 2018-2019, Yann Herklotz +License : BSD-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Functions to mutate the Verilog AST from "VeriFuzz.Verilog.AST" to generate more +random patterns, such as nesting wires instead of creating new ones. +-} + +module VeriFuzz.Verilog.Mutate + ( inPort + , findAssign + , idTrans + , replace + , nestId + , nestSource + , nestUpTo + , allVars + , instantiateMod + , instantiateMod_ + , instantiateModSpec_ + , filterChar + , initMod + , makeIdFrom + , makeTop + , makeTopAssert + , simplify + , removeId + , combineAssigns + , declareMod + ) +where + +import Control.Lens +import Data.Foldable (fold) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import VeriFuzz.Circuit.Internal +import VeriFuzz.Internal +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.Internal + +-- | Return if the 'Identifier' is in a 'ModDecl'. +inPort :: Identifier -> ModDecl -> Bool +inPort i m = inInput + where + inInput = + any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts + +-- | Find the last assignment of a specific wire/reg to an expression, and +-- returns that expression. +findAssign :: Identifier -> [ModItem] -> Maybe Expr +findAssign i items = safe last . catMaybes $ isAssign <$> items + where + isAssign (ModCA (ContAssign val expr)) | val == i = Just expr + | otherwise = Nothing + isAssign _ = Nothing + +-- | Transforms an expression by replacing an Identifier with an +-- expression. This is used inside 'transformOf' and 'traverseExpr' to replace +-- the 'Identifier' recursively. +idTrans :: Identifier -> Expr -> Expr -> Expr +idTrans i expr (Id id') | id' == i = expr + | otherwise = Id id' +idTrans _ _ e = e + +-- | Replaces the identifier recursively in an expression. +replace :: Identifier -> Expr -> Expr -> Expr +replace = (transformOf traverseExpr .) . idTrans + +-- | Nest expressions for a specific 'Identifier'. If the 'Identifier' is not +-- found, the AST is not changed. +-- +-- This could be improved by instead of only using the last assignment to the +-- wire that one finds, to use the assignment to the wire before the current +-- expression. This would require a different approach though. +nestId :: Identifier -> ModDecl -> ModDecl +nestId i m + | not $ inPort i m + = let expr = fromMaybe def . findAssign i $ m ^. modItems + in m & get %~ replace i expr + | otherwise + = m + where + get = modItems . traverse . modContAssign . contAssignExpr + def = Id i + +-- | Replaces an identifier by a expression in all the module declaration. +nestSource :: Identifier -> Verilog -> Verilog +nestSource i src = src & getModule %~ nestId i + +-- | Nest variables in the format @w[0-9]*@ up to a certain number. +nestUpTo :: Int -> Verilog -> Verilog +nestUpTo i src = + foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] + +allVars :: ModDecl -> [Identifier] +allVars m = + (m ^.. modOutPorts . traverse . portName) + <> (m ^.. modInPorts . traverse . portName) + +-- $setup +-- >>> import VeriFuzz.CodeGen +-- >>> let m = (ModDecl (Identifier "m") [Port Wire False 5 (Identifier "y")] [Port Wire False 5 "x"] []) +-- >>> let main = (ModDecl "main" [] [] []) + +-- | Add a Module Instantiation using 'ModInst' from the first module passed to +-- it to the body of the second module. It first has to make all the inputs into +-- @reg@. +-- +-- >>> render $ instantiateMod m main +-- module main; +-- wire [4:0] y; +-- reg [4:0] x; +-- m m1(y, x); +-- endmodule +-- +instantiateMod :: ModDecl -> ModDecl -> ModDecl +instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) + where + out = Decl Nothing <$> m ^. modOutPorts + regIn = Decl Nothing <$> (m ^. modInPorts & traverse . portType .~ Reg) + inst = ModInst (m ^. modId) + (m ^. modId <> (Identifier . showT $ count + 1)) + conns + count = + length + . filter (== m ^. modId) + $ main + ^.. modItems + . traverse + . modInstId + conns = ModConn . Id <$> allVars m + +-- | Instantiate without adding wire declarations. It also does not count the +-- current instantiations of the same module. +-- +-- >>> GenVerilog $ instantiateMod_ m +-- m m(y, x); +-- +instantiateMod_ :: ModDecl -> ModItem +instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns + where + conns = + ModConn + . Id + <$> (m ^.. modOutPorts . traverse . portName) + ++ (m ^.. modInPorts . traverse . portName) + +-- | Instantiate without adding wire declarations. It also does not count the +-- current instantiations of the same module. +-- +-- >>> GenVerilog $ instantiateModSpec_ "_" m +-- m m(.y(y), .x(x)); +-- +instantiateModSpec_ :: Text -> ModDecl -> ModItem +instantiateModSpec_ outChar m = ModInst (m ^. modId) (m ^. modId) conns + where + conns = zipWith ModConnNamed ids (Id <$> instIds) + ids = filterChar outChar (name modOutPorts) <> name modInPorts + instIds = name modOutPorts <> name modInPorts + name v = m ^.. v . traverse . portName + +filterChar :: Text -> [Identifier] -> [Identifier] +filterChar t ids = + ids + & traverse + . getIdentifier + %~ (\x -> fromMaybe x . safe head $ T.splitOn t x) + +-- | Initialise all the inputs and outputs to a module. +-- +-- >>> GenVerilog $ initMod m +-- module m(y, x); +-- output wire [4:0] y; +-- input wire [4:0] x; +-- endmodule +-- +initMod :: ModDecl -> ModDecl +initMod m = m & modItems %~ ((out ++ inp) ++) + where + out = Decl (Just PortOut) <$> (m ^. modOutPorts) + inp = Decl (Just PortIn) <$> (m ^. modInPorts) + +-- | Make an 'Identifier' from and existing Identifier and an object with a +-- 'Show' instance to make it unique. +makeIdFrom :: (Show a) => a -> Identifier -> Identifier +makeIdFrom a i = (i <>) . Identifier . ("_" <>) $ showT a + +-- | Make top level module for equivalence verification. Also takes in how many +-- modules to instantiate. +makeTop :: Int -> ModDecl -> ModDecl +makeTop i m = ModDecl (m ^. modId) ys (m ^. modInPorts) modIt + where + ys = yPort . flip makeIdFrom "y" <$> [1 .. i] + modIt = instantiateModSpec_ "_" . modN <$> [1 .. i] + modN n = + m & modId %~ makeIdFrom n & modOutPorts .~ [yPort (makeIdFrom n "y")] + +-- | Make a top module with an assert that requires @y_1@ to always be equal to +-- @y_2@, which can then be proven using a formal verification tool. +makeTopAssert :: ModDecl -> ModDecl +makeTopAssert = (modItems %~ (++ [assert])) . (modInPorts %~ addClk) . makeTop + 2 + where + assert = Always . EventCtrl e . Just $ SeqBlock + [TaskEnable $ Task "assert" [BinOp (Id "y_1") BinEq (Id "y_2")]] + e = EPosEdge "clk" + addClk = (defaultPort "clk" :) + +-- | Provide declarations for all the ports that are passed to it. +declareMod :: [Port] -> ModDecl -> ModDecl +declareMod ports = initMod . (modItems %~ (decl ++)) + where decl = Decl Nothing <$> ports + +-- | Simplify an 'Expr' by using constants to remove 'BinaryOperator' and +-- simplify expressions. To make this work effectively, it should be run until +-- no more changes were made to the expression. +-- +-- >>> GenVerilog . simplify $ (Id "x") + 0 +-- x +-- +-- >>> GenVerilog . simplify $ (Id "y") + (Id "x") +-- (y + x) +simplify :: Expr -> Expr +simplify (BinOp (Number _ 1) BinAnd e) = e +simplify (BinOp e BinAnd (Number _ 1)) = e +simplify (BinOp (Number _ 0) BinAnd _) = Number 1 0 +simplify (BinOp _ BinAnd (Number _ 0)) = Number 1 0 +simplify (BinOp e BinPlus (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinPlus e) = e +simplify (BinOp e BinMinus (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinMinus e) = e +simplify (BinOp e BinTimes (Number _ 1)) = e +simplify (BinOp (Number _ 1) BinTimes e) = e +simplify (BinOp _ BinTimes (Number _ 0)) = Number 1 0 +simplify (BinOp (Number _ 0) BinTimes _) = Number 1 0 +simplify (BinOp e BinOr (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinOr e) = e +simplify (BinOp e BinLSL (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinLSL e) = e +simplify (BinOp e BinLSR (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinLSR e) = e +simplify (BinOp e BinASL (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinASL e) = e +simplify (BinOp e BinASR (Number _ 0)) = e +simplify (BinOp (Number _ 0) BinASR e) = e +simplify (UnOp UnPlus e) = e +simplify e = e + +-- | Remove all 'Identifier' that do not appeare in the input list from an +-- 'Expr'. The identifier will be replaced by @1'b0@, which can then later be +-- simplified further. +-- +-- >>> GenVerilog . removeId ["x"] $ Id "x" + Id "y" +-- (x + (1'h0)) +removeId :: [Identifier] -> Expr -> Expr +removeId i = transform trans + where + trans (Id ident) | ident `notElem` i = Number 1 0 + | otherwise = Id ident + trans e = e + +combineAssigns :: Port -> [ModItem] -> [ModItem] +combineAssigns p a = + a <> [ModCA . ContAssign (p ^. portName) . fold $ Id <$> assigns] + where assigns = a ^.. traverse . modContAssign . contAssignNetLVal diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs new file mode 100644 index 0000000..5e8bb55 --- /dev/null +++ b/src/VeriFuzz/Verilog/Parser.hs @@ -0,0 +1,316 @@ +{-| +Module : VeriFuzz.Verilog.Parser +Description : Minimal Verilog parser to reconstruct the AST. +Copyright : (c) 2019, Yann Herklotz +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Minimal Verilog parser to reconstruct the AST. This parser does not support the +whole Verilog syntax, as the AST does not support it either. +-} + +module VeriFuzz.Verilog.Parser + ( -- * Parser + parseVerilog + , parseModDecl + ) +where + +import Control.Lens +import Control.Monad (void) +import Data.Bifunctor (bimap) +import Data.Bits +import Data.Functor (($>)) +import Data.Functor.Identity (Identity) +import Data.List (isInfixOf, isPrefixOf) +import qualified Data.Text as T +import Text.Parsec hiding (satisfy) +import Text.Parsec.Expr +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.Internal +import VeriFuzz.Verilog.Lex +import VeriFuzz.Verilog.Preprocess +import VeriFuzz.Verilog.Token + + +type Parser = Parsec [Token] () + +type ParseOperator = Operator [Token] () Identity + +data Decimal = Decimal Int Integer + +instance Num Decimal where + (Decimal sa na) + (Decimal sb nb) = Decimal (max sa sb) (na + nb) + (Decimal sa na) - (Decimal sb nb) = Decimal (max sa sb) (na - nb) + (Decimal sa na) * (Decimal sb nb) = Decimal (max sa sb) (na * nb) + negate (Decimal s n) = Decimal s $ negate n + abs (Decimal s n) = Decimal s $ abs n + signum (Decimal s n) = Decimal s $ signum n + fromInteger = Decimal 32 . fromInteger + +-- | This parser succeeds whenever the given predicate returns true when called +-- with parsed `Token`. Same as 'Text.Parsec.Char.satisfy'. +satisfy :: (Token -> Bool) -> Parser TokenName +satisfy f = tokenPrim show nextPos tokeq + where + tokeq :: Token -> Maybe TokenName + tokeq t@(Token t' _ _) = if f t then Just t' else Nothing + +satisfy' :: (Token -> Maybe a) -> Parser a +satisfy' = tokenPrim show nextPos + +nextPos :: SourcePos -> Token -> [Token] -> SourcePos +nextPos pos _ (Token _ _ (Position _ l c) : _) = + setSourceColumn (setSourceLine pos l) c +nextPos pos _ [] = pos + +-- | Parses given `TokenName`. +tok :: TokenName -> Parser TokenName +tok t = satisfy (\(Token t' _ _) -> t' == t) show t + +-- | Parse without returning the `TokenName`. +tok' :: TokenName -> Parser () +tok' p = void $ tok p + +parens :: Parser a -> Parser a +parens = between (tok SymParenL) (tok SymParenR) + +braces :: Parser a -> Parser a +braces = between (tok SymBraceL) (tok SymBraceR) + +sBinOp :: BinaryOperator -> Expr -> Expr -> Expr +sBinOp = sOp BinOp where sOp f b a = f a b + +parseExpr' :: Parser Expr +parseExpr' = buildExpressionParser parseTable parseTerm "expr" + +decToExpr :: Decimal -> Expr +decToExpr (Decimal s n) = Number s n + +-- | Parse a Number depending on if it is in a hex or decimal form. Octal and +-- binary are not supported yet. +parseNum :: Parser Expr +parseNum = decToExpr <$> number + +parseVar :: Parser Expr +parseVar = Id <$> identifier + +systemFunc :: String -> Parser String +systemFunc s = satisfy' matchId + where + matchId (Token IdSystem s' _) = if s == s' then Just s else Nothing + matchId _ = Nothing + +parseFunction :: Parser Function +parseFunction = + systemFunc "$unsigned" + $> UnSignedFunc + <|> systemFunc "$signed" + $> SignedFunc + +parseFun :: Parser Expr +parseFun = do + f <- parseFunction + expr <- parens parseExpr + return $ Func f expr + +parseTerm :: Parser Expr +parseTerm = + parens parseExpr + <|> (Concat <$> braces (commaSep parseExpr)) + <|> parseFun + <|> parseNum + <|> parseVar + "simple expr" + +-- | Parses the ternary conditional operator. It will behave in a right +-- associative way. +parseCond :: Expr -> Parser Expr +parseCond e = do + tok' SymQuestion + expr <- parseExpr + tok' SymColon + Cond e expr <$> parseExpr + +parseExpr :: Parser Expr +parseExpr = do + e <- parseExpr' + option e . try $ parseCond e + +-- | Table of binary and unary operators that encode the right precedence for +-- each. +parseTable :: [[ParseOperator Expr]] +parseTable = + [ [prefix SymBang (UnOp UnLNot), prefix SymTildy (UnOp UnNot)] + , [ prefix SymAmp (UnOp UnAnd) + , prefix SymBar (UnOp UnOr) + , prefix SymTildyAmp (UnOp UnNand) + , prefix SymTildyBar (UnOp UnNor) + , prefix SymHat (UnOp UnXor) + , prefix SymTildyHat (UnOp UnNxor) + , prefix SymHatTildy (UnOp UnNxorInv) + ] + , [prefix SymPlus (UnOp UnPlus), prefix SymDash (UnOp UnMinus)] + , [binary SymAsterAster (sBinOp BinPower) AssocRight] + , [ binary SymAster (sBinOp BinTimes) AssocLeft + , binary SymSlash (sBinOp BinDiv) AssocLeft + , binary SymPercent (sBinOp BinMod) AssocLeft + ] + , [ binary SymPlus (sBinOp BinPlus) AssocLeft + , binary SymDash (sBinOp BinPlus) AssocLeft + ] + , [ binary SymLtLt (sBinOp BinLSL) AssocLeft + , binary SymGtGt (sBinOp BinLSR) AssocLeft + ] + , [ binary SymLtLtLt (sBinOp BinASL) AssocLeft + , binary SymGtGtGt (sBinOp BinASR) AssocLeft + ] + , [ binary SymLt (sBinOp BinLT) AssocNone + , binary SymGt (sBinOp BinGT) AssocNone + , binary SymLtEq (sBinOp BinLEq) AssocNone + , binary SymGtEq (sBinOp BinLEq) AssocNone + ] + , [ binary SymEqEq (sBinOp BinEq) AssocNone + , binary SymBangEq (sBinOp BinNEq) AssocNone + ] + , [ binary SymEqEqEq (sBinOp BinEq) AssocNone + , binary SymBangEqEq (sBinOp BinNEq) AssocNone + ] + , [binary SymAmp (sBinOp BinAnd) AssocLeft] + , [ binary SymHat (sBinOp BinXor) AssocLeft + , binary SymHatTildy (sBinOp BinXNor) AssocLeft + , binary SymTildyHat (sBinOp BinXNorInv) AssocLeft + ] + , [binary SymBar (sBinOp BinOr) AssocLeft] + , [binary SymAmpAmp (sBinOp BinLAnd) AssocLeft] + , [binary SymBarBar (sBinOp BinLOr) AssocLeft] + ] + +binary :: TokenName -> (a -> a -> a) -> Assoc -> ParseOperator a +binary name fun = Infix ((tok name "binary") >> return fun) + +prefix :: TokenName -> (a -> a) -> ParseOperator a +prefix name fun = Prefix ((tok name "prefix") >> return fun) + +commaSep :: Parser a -> Parser [a] +commaSep = flip sepBy $ tok SymComma + +parseContAssign :: Parser ContAssign +parseContAssign = do + var <- tok KWAssign *> identifier + expr <- tok SymEq *> parseExpr + tok' SymSemi + return $ ContAssign var expr + +numLit :: Parser String +numLit = satisfy' matchId + where + matchId (Token LitNumber s _) = Just s + matchId _ = Nothing + +number :: Parser Decimal +number = number' <$> numLit + where + number' :: String -> Decimal + number' a | all (`elem` ['0' .. '9']) a = fromInteger $ read a + | head a == '\'' = fromInteger $ f a + | "'" `isInfixOf` a = Decimal (read w) (f b) + | otherwise = error $ "Invalid number format: " ++ a + where + w = takeWhile (/= '\'') a + b = dropWhile (/= '\'') a + f a' + | "'d" `isPrefixOf` a' = read $ drop 2 a' + | "'h" `isPrefixOf` a' = read $ "0x" ++ drop 2 a' + | "'b" `isPrefixOf` a' = foldl + (\n b' -> shiftL n 1 .|. (if b' == '1' then 1 else 0)) + 0 + (drop 2 a') + | otherwise = error $ "Invalid number format: " ++ a' + +toInteger' :: Decimal -> Integer +toInteger' (Decimal _ n) = n + +-- | Parse a range and return the total size. As it is inclusive, 1 has to be +-- added to the difference. +parseRange :: Parser Int +parseRange = do + rangeH <- tok SymBrackL *> number + rangeL <- tok SymColon *> number + tok' SymBrackR + return . fromInteger . toInteger' $ rangeH - rangeL + 1 + +strId :: Parser String +strId = satisfy' matchId + where + matchId (Token IdSimple s _) = Just s + matchId (Token IdEscaped s _) = Just s + matchId _ = Nothing + +identifier :: Parser Identifier +identifier = Identifier . T.pack <$> strId + +parseNetDecl :: Maybe PortDir -> Parser ModItem +parseNetDecl pd = do + t <- option Wire type_ + sign <- option False (tok KWSigned $> True) + range <- option 1 parseRange + name <- identifier + tok' SymSemi + return . Decl pd . Port t sign range $ name + where type_ = tok KWWire $> Wire <|> tok KWReg $> Reg + +parsePortDir :: Parser PortDir +parsePortDir = + tok KWOutput + $> PortOut + <|> tok KWInput + $> PortIn + <|> tok KWInout + $> PortInOut + +parseDecl :: Parser ModItem +parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing + +parseModItem :: Parser ModItem +parseModItem = (ModCA <$> parseContAssign) <|> parseDecl + +parseModList :: Parser [Identifier] +parseModList = list <|> return [] where list = parens $ commaSep identifier + +filterDecl :: PortDir -> ModItem -> Bool +filterDecl p (Decl (Just p') _) = p == p' +filterDecl _ _ = False + +modPorts :: PortDir -> [ModItem] -> [Port] +modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort + +parseModDecl :: Parser ModDecl +parseModDecl = do + name <- tok KWModule *> identifier + _ <- fmap defaultPort <$> parseModList + tok' SymSemi + modItem <- option [] . try $ many1 parseModItem + tok' KWEndmodule + return $ ModDecl name + (modPorts PortOut modItem) + (modPorts PortIn modItem) + modItem + +parseDescription :: Parser Description +parseDescription = Description <$> parseModDecl + +-- | Parses a 'String' into 'Verilog' by skipping any beginning whitespace +-- and then parsing multiple Verilog source. +parseVerilogSrc :: Parser Verilog +parseVerilogSrc = Verilog <$> many parseDescription + +-- | Parse a 'String' containing verilog code. The parser currently only supports +-- the subset of Verilog that is being generated randomly. +parseVerilog :: String -- ^ Name of parsed object. + -> String -- ^ Content to be parsed. + -> Either String Verilog -- ^ Returns 'String' with error + -- message if parse fails. +parseVerilog s = bimap show id . parse parseVerilogSrc s . alexScanTokens . preprocess [] s diff --git a/src/VeriFuzz/Verilog/Preprocess.hs b/src/VeriFuzz/Verilog/Preprocess.hs new file mode 100644 index 0000000..fead5f0 --- /dev/null +++ b/src/VeriFuzz/Verilog/Preprocess.hs @@ -0,0 +1,108 @@ +{-| +Module : VeriFuzz.Verilog.Preprocess +Description : Simple preprocessor for `define and comments. +Copyright : (c) 2011-2015 Tom Hawkins, 2019 Yann Herklotz +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Simple preprocessor for `define and comments. + +The code is from https://github.com/tomahawkins/verilog. + +Edits to the original code are warning fixes and formatting changes. +-} + +module VeriFuzz.Verilog.Preprocess + ( uncomment + , preprocess + ) +where + +-- | Remove comments from code. +uncomment :: FilePath -> String -> String +uncomment file = uncomment' + where + uncomment' a = case a of + "" -> "" + '/' : '/' : rest -> " " ++ removeEOL rest + '/' : '*' : rest -> " " ++ remove rest + '"' : rest -> '"' : ignoreString rest + b : rest -> b : uncomment' rest + + removeEOL a = case a of + "" -> "" + '\n' : rest -> '\n' : uncomment' rest + '\t' : rest -> '\t' : removeEOL rest + _ : rest -> ' ' : removeEOL rest + + remove a = case a of + "" -> error $ "File ended without closing comment (*/): " ++ file + '"' : rest -> removeString rest + '\n' : rest -> '\n' : remove rest + '\t' : rest -> '\t' : remove rest + '*' : '/' : rest -> " " ++ uncomment' rest + _ : rest -> " " ++ remove rest + + removeString a = case a of + "" -> error $ "File ended without closing string: " ++ file + '"' : rest -> " " ++ remove rest + '\\' : '"' : rest -> " " ++ removeString rest + '\n' : rest -> '\n' : removeString rest + '\t' : rest -> '\t' : removeString rest + _ : rest -> ' ' : removeString rest + + ignoreString a = case a of + "" -> error $ "File ended without closing string: " ++ file + '"' : rest -> '"' : uncomment' rest + '\\' : '"' : rest -> "\\\"" ++ ignoreString rest + b : rest -> b : ignoreString rest + +-- | A simple `define preprocessor. +preprocess :: [(String, String)] -> FilePath -> String -> String +preprocess env file content = unlines $ pp True [] env $ lines $ uncomment + file + content + where + pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String] + pp _ _ _ [] = [] + pp on stack env_ (a : rest) = case words a of + "`define" : name : value -> + "" + : pp + on + stack + (if on + then (name, ppLine env_ $ unwords value) : env_ + else env_ + ) + rest + "`ifdef" : name : _ -> + "" : pp (on && elem name (map fst env_)) (on : stack) env_ rest + "`ifndef" : name : _ -> + "" : pp (on && notElem name (map fst env_)) (on : stack) env_ rest + "`else" : _ + | not $ null stack + -> "" : pp (head stack && not on) stack env_ rest + | otherwise + -> error $ "`else without associated `ifdef/`ifndef: " ++ file + "`endif" : _ + | not $ null stack + -> "" : pp (head stack) (tail stack) env_ rest + | otherwise + -> error $ "`endif without associated `ifdef/`ifndef: " ++ file + _ -> (if on then ppLine env_ a else "") : pp on stack env_ rest + +ppLine :: [(String, String)] -> String -> String +ppLine _ "" = "" +ppLine env ('`' : a) = case lookup name env of + Just value -> value ++ ppLine env rest + Nothing -> error $ "Undefined macro: `" ++ name ++ " Env: " ++ show env + where + name = takeWhile + (flip elem $ ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ ['_']) + a + rest = drop (length name) a +ppLine env (a : b) = a : ppLine env b + diff --git a/src/VeriFuzz/Verilog/Token.hs b/src/VeriFuzz/Verilog/Token.hs new file mode 100644 index 0000000..65c2319 --- /dev/null +++ b/src/VeriFuzz/Verilog/Token.hs @@ -0,0 +1,350 @@ +{-| +Module : VeriFuzz.Verilog.Token +Description : Tokens for Verilog parsing. +Copyright : (c) 2019, Yann Herklotz Grave +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Tokens for Verilog parsing. +-} + +module VeriFuzz.Verilog.Token + ( Token(..) + , TokenName(..) + , Position(..) + , tokenString + ) +where + +import Text.Printf + +tokenString :: Token -> String +tokenString (Token _ s _) = s + +data Position = Position String Int Int deriving Eq + +instance Show Position where + show (Position f l c) = printf "%s:%d:%d" f l c + +data Token = Token TokenName String Position deriving (Show, Eq) + +data TokenName + = KWAlias + | KWAlways + | KWAlwaysComb + | KWAlwaysFf + | KWAlwaysLatch + | KWAnd + | KWAssert + | KWAssign + | KWAssume + | KWAutomatic + | KWBefore + | KWBegin + | KWBind + | KWBins + | KWBinsof + | KWBit + | KWBreak + | KWBuf + | KWBufif0 + | KWBufif1 + | KWByte + | KWCase + | KWCasex + | KWCasez + | KWCell + | KWChandle + | KWClass + | KWClocking + | KWCmos + | KWConfig + | KWConst + | KWConstraint + | KWContext + | KWContinue + | KWCover + | KWCovergroup + | KWCoverpoint + | KWCross + | KWDeassign + | KWDefault + | KWDefparam + | KWDesign + | KWDisable + | KWDist + | KWDo + | KWEdge + | KWElse + | KWEnd + | KWEndcase + | KWEndclass + | KWEndclocking + | KWEndconfig + | KWEndfunction + | KWEndgenerate + | KWEndgroup + | KWEndinterface + | KWEndmodule + | KWEndpackage + | KWEndprimitive + | KWEndprogram + | KWEndproperty + | KWEndspecify + | KWEndsequence + | KWEndtable + | KWEndtask + | KWEnum + | KWEvent + | KWExpect + | KWExport + | KWExtends + | KWExtern + | KWFinal + | KWFirstMatch + | KWFor + | KWForce + | KWForeach + | KWForever + | KWFork + | KWForkjoin + | KWFunction + | KWFunctionPrototype + | KWGenerate + | KWGenvar + | KWHighz0 + | KWHighz1 + | KWIf + | KWIff + | KWIfnone + | KWIgnoreBins + | KWIllegalBins + | KWImport + | KWIncdir + | KWInclude + | KWInitial + | KWInout + | KWInput + | KWInside + | KWInstance + | KWInt + | KWInteger + | KWInterface + | KWIntersect + | KWJoin + | KWJoinAny + | KWJoinNone + | KWLarge + | KWLiblist + | KWLibrary + | KWLocal + | KWLocalparam + | KWLogic + | KWLongint + | KWMacromodule + | KWMatches + | KWMedium + | KWModport + | KWModule + | KWNand + | KWNegedge + | KWNew + | KWNmos + | KWNor + | KWNoshowcancelled + | KWNot + | KWNotif0 + | KWNotif1 + | KWNull + | KWOption + | KWOr + | KWOutput + | KWPackage + | KWPacked + | KWParameter + | KWPathpulseDollar + | KWPmos + | KWPosedge + | KWPrimitive + | KWPriority + | KWProgram + | KWProperty + | KWProtected + | KWPull0 + | KWPull1 + | KWPulldown + | KWPullup + | KWPulsestyleOnevent + | KWPulsestyleOndetect + | KWPure + | KWRand + | KWRandc + | KWRandcase + | KWRandsequence + | KWRcmos + | KWReal + | KWRealtime + | KWRef + | KWReg + | KWRelease + | KWRepeat + | KWReturn + | KWRnmos + | KWRpmos + | KWRtran + | KWRtranif0 + | KWRtranif1 + | KWScalared + | KWSequence + | KWShortint + | KWShortreal + | KWShowcancelled + | KWSigned + | KWSmall + | KWSolve + | KWSpecify + | KWSpecparam + | KWStatic + | KWStrength0 + | KWStrength1 + | KWString + | KWStrong0 + | KWStrong1 + | KWStruct + | KWSuper + | KWSupply0 + | KWSupply1 + | KWTable + | KWTagged + | KWTask + | KWThis + | KWThroughout + | KWTime + | KWTimeprecision + | KWTimeunit + | KWTran + | KWTranif0 + | KWTranif1 + | KWTri + | KWTri0 + | KWTri1 + | KWTriand + | KWTrior + | KWTrireg + | KWType + | KWTypedef + | KWTypeOption + | KWUnion + | KWUnique + | KWUnsigned + | KWUse + | KWVar + | KWVectored + | KWVirtual + | KWVoid + | KWWait + | KWWaitOrder + | KWWand + | KWWeak0 + | KWWeak1 + | KWWhile + | KWWildcard + | KWWire + | KWWith + | KWWithin + | KWWor + | KWXnor + | KWXor + | IdSimple + | IdEscaped + | IdSystem + | LitNumberUnsigned + | LitNumber + | LitString + | SymParenL + | SymParenR + | SymBrackL + | SymBrackR + | SymBraceL + | SymBraceR + | SymTildy + | SymBang + | SymAt + | SymPound + | SymPercent + | SymHat + | SymAmp + | SymBar + | SymAster + | SymDot + | SymComma + | SymColon + | SymSemi + | SymEq + | SymLt + | SymGt + | SymPlus + | SymDash + | SymQuestion + | SymSlash + | SymDollar + | SymSQuote + | SymTildyAmp + | SymTildyBar + | SymTildyHat + | SymHatTildy + | SymEqEq + | SymBangEq + | SymAmpAmp + | SymBarBar + | SymAsterAster + | SymLtEq + | SymGtEq + | SymGtGt + | SymLtLt + | SymPlusPlus + | SymDashDash + | SymPlusEq + | SymDashEq + | SymAsterEq + | SymSlashEq + | SymPercentEq + | SymAmpEq + | SymBarEq + | SymHatEq + | SymPlusColon + | SymDashColon + | SymColonColon + | SymDotAster + | SymDashGt + | SymColonEq + | SymColonSlash + | SymPoundPound + | SymBrackLAster + | SymBrackLEq + | SymEqGt + | SymAtAster + | SymParenLAster + | SymAsterParenR + | SymAsterGt + | SymEqEqEq + | SymBangEqEq + | SymEqQuestionEq + | SymBangQuestionEq + | SymGtGtGt + | SymLtLtLt + | SymLtLtEq + | SymGtGtEq + | SymBarDashGt + | SymBarEqGt + | SymBrackLDashGt + | SymAtAtParenL + | SymParenLAsterParenR + | SymDashGtGt + | SymAmpAmpAmp + | SymLtLtLtEq + | SymGtGtGtEq + | Unknown + deriving (Show, Eq) -- cgit