From cccb665ebac6e916c4f961eacbe11a9af7d7ceb3 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Thu, 29 Aug 2019 15:44:33 +1000 Subject: Change name from VeriFuzz to VeriSmith --- src/VeriFuzz/Verilog/AST.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/VeriFuzz/Verilog/AST.hs') diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs index a85c365..78bad45 100644 --- a/src/VeriFuzz/Verilog/AST.hs +++ b/src/VeriFuzz/Verilog/AST.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.AST +Module : VeriSmith.Verilog.AST Description : Definition of the Verilog AST types. Copyright : (c) 2018-2019, Yann Herklotz License : BSD-3 @@ -22,7 +22,7 @@ Defines the types to build a Verilog AST. {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module VeriFuzz.Verilog.AST +module VeriSmith.Verilog.AST ( -- * Top level types SourceInfo(..) , infoTop @@ -150,7 +150,7 @@ import Data.String (IsString, fromString) import Data.Text (Text, pack) import Data.Traversable (sequenceA) import GHC.Generics (Generic) -import VeriFuzz.Verilog.BitVec +import VeriSmith.Verilog.BitVec -- | 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, -- cgit From a2b01b92612a098673ff03890e6e8aef4ceb28ea Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Wed, 4 Sep 2019 20:15:51 +1000 Subject: Renaming to VeriSmith --- src/VeriFuzz/Verilog/AST.hs | 583 -------------------------------------------- 1 file changed, 583 deletions(-) delete mode 100644 src/VeriFuzz/Verilog/AST.hs (limited to 'src/VeriFuzz/Verilog/AST.hs') diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs deleted file mode 100644 index 78bad45..0000000 --- a/src/VeriFuzz/Verilog/AST.hs +++ /dev/null @@ -1,583 +0,0 @@ -{-| -Module : VeriSmith.Verilog.AST -Description : Definition of the Verilog AST types. -Copyright : (c) 2018-2019, Yann Herklotz -License : BSD-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Poratbility : POSIX - -Defines the types to build a Verilog AST. --} - -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -module VeriSmith.Verilog.AST - ( -- * Top level types - SourceInfo(..) - , infoTop - , infoSrc - , Verilog(..) - -- * Primitives - -- ** Identifier - , Identifier(..) - -- ** Control - , Delay(..) - , Event(..) - -- ** Operators - , BinaryOperator(..) - , UnaryOperator(..) - -- ** Task - , Task(..) - , taskName - , taskExpr - -- ** Left hand side value - , LVal(..) - , regId - , regExprId - , regExpr - , regSizeId - , regSizeRange - , regConc - -- ** Ports - , PortDir(..) - , PortType(..) - , Port(..) - , portType - , portSigned - , portSize - , portName - -- * Expression - , Expr(..) - , ConstExpr(..) - , ConstExprF(..) - , constToExpr - , exprToConst - , Range(..) - , constNum - , constParamId - , constConcat - , constUnOp - , constPrim - , constLhs - , constBinOp - , constRhs - , constCond - , constTrue - , constFalse - , constStr - -- * Assignment - , Assign(..) - , assignReg - , assignDelay - , assignExpr - , ContAssign(..) - , contAssignNetLVal - , contAssignExpr - -- ** Parameters - , Parameter(..) - , paramIdent - , paramValue - , LocalParam(..) - , localParamIdent - , localParamValue - -- * Statment - , Statement(..) - , statDelay - , statDStat - , statEvent - , statEStat - , statements - , stmntBA - , stmntNBA - , stmntTask - , stmntSysTask - , stmntCondExpr - , stmntCondTrue - , stmntCondFalse - , forAssign - , forExpr - , forIncr - , forStmnt - -- * Module - , ModDecl(..) - , modId - , modOutPorts - , modInPorts - , modItems - , modParams - , ModItem(..) - , modContAssign - , modInstId - , modInstName - , modInstConns - , _Initial - , _Always - , paramDecl - , localParamDecl - , traverseModItem - , declDir - , declPort - , declVal - , ModConn(..) - , modConnName - , modExpr - -- * Useful Lenses and Traversals - , aModule - , getModule - , getSourceId - , mainModule - ) -where - -import Control.DeepSeq (NFData) -import Control.Lens hiding ((<|)) -import Data.Data -import Data.Data.Lens -import Data.Functor.Foldable.TH (makeBaseFunctor) -import Data.List.NonEmpty (NonEmpty (..), (<|)) -import Data.String (IsString, fromString) -import Data.Text (Text, pack) -import Data.Traversable (sequenceA) -import GHC.Generics (Generic) -import VeriSmith.Verilog.BitVec - --- | 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, Generic, NFData) - -instance IsString Identifier where - fromString = Identifier . pack - -instance Semigroup Identifier where - Identifier a <> Identifier b = Identifier $ a <> b - -instance Monoid Identifier where - mempty = Identifier mempty - --- | Verilog syntax for adding a delay, which is represented as @#num@. -newtype Delay = Delay { _getDelay :: Int } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -instance Num Delay where - Delay a + Delay b = Delay $ a + b - Delay a - Delay b = Delay $ a - b - Delay a * Delay b = Delay $ a * b - negate (Delay a) = Delay $ negate a - abs (Delay a) = Delay $ abs a - signum (Delay a) = Delay $ signum a - fromInteger = Delay . fromInteger - --- | 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 - | EOr !Event !Event - | EComb !Event !Event - deriving (Eq, Show, Ord, Data, Generic, NFData) - -instance Plated Event where - plate = uniplate - --- | 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, Generic, NFData) - --- | 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, Generic, NFData) - --- | Verilog expression, which can either be a primary expression, unary --- expression, binary operator expression or a conditional expression. -data Expr = Number {-# UNPACK #-} !BitVec - -- ^ Number implementation containing the size and the value itself - | Id {-# UNPACK #-} !Identifier - | VecSelect {-# UNPACK #-} !Identifier !Expr - | RangeSelect {-# UNPACK #-} !Identifier !Range - -- ^ Symbols - | Concat !(NonEmpty Expr) - -- ^ Bit-wise concatenation of expressions represented by braces. - | UnOp !UnaryOperator !Expr - | BinOp !Expr !BinaryOperator !Expr - | Cond !Expr !Expr !Expr - | Appl !Identifier !Expr - | Str {-# UNPACK #-} !Text - deriving (Eq, Show, Ord, Data, Generic, NFData) - -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 . 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 = Number 0 - -instance IsString Expr where - fromString = Str . fromString - -instance Plated Expr where - plate = uniplate - --- | Constant expression, which are known before simulation at compile time. -data ConstExpr = ConstNum { _constNum :: {-# UNPACK #-} !BitVec } - | ParamId { _constParamId :: {-# UNPACK #-} !Identifier } - | ConstConcat { _constConcat :: !(NonEmpty ConstExpr) } - | ConstUnOp { _constUnOp :: !UnaryOperator - , _constPrim :: !ConstExpr - } - | ConstBinOp { _constLhs :: !ConstExpr - , _constBinOp :: !BinaryOperator - , _constRhs :: !ConstExpr - } - | ConstCond { _constCond :: !ConstExpr - , _constTrue :: !ConstExpr - , _constFalse :: !ConstExpr - } - | ConstStr { _constStr :: {-# UNPACK #-} !Text } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -constToExpr :: ConstExpr -> Expr -constToExpr (ConstNum a ) = Number a -constToExpr (ParamId a ) = Id a -constToExpr (ConstConcat a ) = Concat $ fmap constToExpr a -constToExpr (ConstUnOp a b ) = UnOp a $ constToExpr b -constToExpr (ConstBinOp a b c) = BinOp (constToExpr a) b $ constToExpr c -constToExpr (ConstCond a b c) = - Cond (constToExpr a) (constToExpr b) $ constToExpr c -constToExpr (ConstStr a) = Str a - -exprToConst :: Expr -> ConstExpr -exprToConst (Number a ) = ConstNum a -exprToConst (Id a ) = ParamId a -exprToConst (Concat a ) = ConstConcat $ fmap exprToConst a -exprToConst (UnOp a b ) = ConstUnOp a $ exprToConst b -exprToConst (BinOp a b c) = ConstBinOp (exprToConst a) b $ exprToConst c -exprToConst (Cond a b c) = - ConstCond (exprToConst a) (exprToConst b) $ exprToConst c -exprToConst (Str a) = ConstStr a -exprToConst _ = error "Not a constant expression" - -instance Num ConstExpr where - a + b = ConstBinOp a BinPlus b - a - b = ConstBinOp a BinMinus b - a * b = ConstBinOp a BinTimes b - negate = ConstUnOp UnMinus - abs = undefined - signum = undefined - fromInteger = ConstNum . fromInteger - -instance Semigroup ConstExpr where - (ConstConcat a) <> (ConstConcat b) = ConstConcat $ a <> b - (ConstConcat a) <> b = ConstConcat $ a <> (b :| []) - a <> (ConstConcat b) = ConstConcat $ a <| b - a <> b = ConstConcat $ a <| b :| [] - -instance Monoid ConstExpr where - mempty = ConstNum 0 - -instance IsString ConstExpr where - fromString = ConstStr . fromString - -instance Plated ConstExpr where - plate = uniplate - -data Task = Task { _taskName :: {-# UNPACK #-} !Identifier - , _taskExpr :: [Expr] - } deriving (Eq, Show, Ord, Data, Generic, NFData) - --- | 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 - , _regSizeRange :: {-# UNPACK #-} !Range - } - | RegConcat { _regConc :: [Expr] } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -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, Generic, NFData) - --- | 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, Generic, NFData) - --- | Range that can be associated with any port or left hand side. Contains the --- msb and lsb bits as 'ConstExpr'. This means that they can be generated using --- parameters, which can in turn be changed at synthesis time. -data Range = Range { rangeMSB :: !ConstExpr - , rangeLSB :: !ConstExpr - } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -instance Num Range where - (Range s1 a) + (Range s2 b) = Range (s1 + s2) $ a + b - (Range s1 a) - (Range s2 b) = Range (s1 - s2) . max 0 $ a - b - (Range s1 a) * (Range s2 b) = Range (s1 * s2) $ a * b - negate = undefined - abs = id - signum _ = 1 - fromInteger = flip Range 0 . fromInteger . (-) 1 - --- | 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 #-} !Range - , _portName :: {-# UNPACK #-} !Identifier - } deriving (Eq, Show, Ord, Data, Generic, NFData) - --- | This is currently a type because direct module declaration should also be --- added: --- --- @ --- mod a(.y(y1), .x1(x11), .x2(x22)); --- @ -data ModConn = ModConn { _modExpr :: !Expr } - | ModConnNamed { _modConnName :: {-# UNPACK #-} !Identifier - , _modExpr :: !Expr - } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -data Assign = Assign { _assignReg :: !LVal - , _assignDelay :: !(Maybe Delay) - , _assignExpr :: !Expr - } deriving (Eq, Show, Ord, Data, Generic, NFData) - -data ContAssign = ContAssign { _contAssignNetLVal :: {-# UNPACK #-} !Identifier - , _contAssignExpr :: !Expr - } deriving (Eq, Show, Ord, Data, Generic, NFData) - --- | 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 (@<=@) - | TaskEnable { _stmntTask :: !Task } - | SysTaskEnable { _stmntSysTask :: !Task } - | CondStmnt { _stmntCondExpr :: Expr - , _stmntCondTrue :: Maybe Statement - , _stmntCondFalse :: Maybe Statement - } - | ForLoop { _forAssign :: !Assign - , _forExpr :: Expr - , _forIncr :: !Assign - , _forStmnt :: Statement - } -- ^ Loop bounds shall be statically computable for a for loop. - deriving (Eq, Show, Ord, Data, Generic, NFData) - -instance Plated Statement where - plate = uniplate - -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 [] - --- | Parameter that can be assigned in blocks or modules using @parameter@. -data Parameter = Parameter { _paramIdent :: {-# UNPACK #-} !Identifier - , _paramValue :: ConstExpr - } - deriving (Eq, Show, Ord, Data, Generic, NFData) - --- | Local parameter that can be assigned anywhere using @localparam@. It cannot --- be changed by initialising the module. -data LocalParam = LocalParam { _localParamIdent :: {-# UNPACK #-} !Identifier - , _localParamValue :: ConstExpr - } - deriving (Eq, Show, Ord, Data, Generic, NFData) - --- | 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 - , _declVal :: Maybe ConstExpr - } - | ParamDecl { _paramDecl :: NonEmpty Parameter } - | LocalParamDecl { _localParamDecl :: NonEmpty LocalParam } - deriving (Eq, Show, Ord, Data, Generic, NFData) - --- | 'module' module_identifier [list_of_ports] ';' { module_item } 'end_module' -data ModDecl = ModDecl { _modId :: {-# UNPACK #-} !Identifier - , _modOutPorts :: ![Port] - , _modInPorts :: ![Port] - , _modItems :: ![ModItem] - , _modParams :: ![Parameter] - } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -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 - --- | The complete sourcetext for the Verilog module. -newtype Verilog = Verilog { getVerilog :: [ModDecl] } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -instance Semigroup Verilog where - Verilog a <> Verilog b = Verilog $ a <> b - -instance Monoid Verilog where - mempty = Verilog mempty - -data SourceInfo = SourceInfo { _infoTop :: {-# UNPACK #-} !Text - , _infoSrc :: !Verilog - } - deriving (Eq, Show, Ord, Data, Generic, NFData) - -$(makeLenses ''Expr) -$(makeLenses ''ConstExpr) -$(makeLenses ''Task) -$(makeLenses ''LVal) -$(makeLenses ''PortType) -$(makeLenses ''Port) -$(makeLenses ''ModConn) -$(makeLenses ''Assign) -$(makeLenses ''ContAssign) -$(makeLenses ''Statement) -$(makeLenses ''ModItem) -$(makeLenses ''Parameter) -$(makeLenses ''LocalParam) -$(makeLenses ''ModDecl) -$(makeLenses ''SourceInfo) -$(makeWrapped ''Verilog) -$(makeWrapped ''Identifier) -$(makeWrapped ''Delay) -$(makePrisms ''ModItem) - -$(makeBaseFunctor ''Event) -$(makeBaseFunctor ''Expr) -$(makeBaseFunctor ''ConstExpr) - -getModule :: Traversal' Verilog ModDecl -getModule = _Wrapped . traverse -{-# INLINE getModule #-} - -getSourceId :: Traversal' Verilog Text -getSourceId = getModule . modId . _Wrapped -{-# INLINE getSourceId #-} - --- | May need to change this to Traversal to be safe. For now it will fail when --- the main has not been properly set with. -aModule :: Identifier -> Lens' SourceInfo ModDecl -aModule t = lens get_ set_ - where - set_ (SourceInfo top main) v = - SourceInfo top (main & getModule %~ update (getIdentifier t) v) - update top v m@(ModDecl (Identifier i) _ _ _ _) | i == top = v - | otherwise = m - get_ (SourceInfo _ main) = - head . filter (f $ getIdentifier t) $ main ^.. getModule - f top (ModDecl (Identifier i) _ _ _ _) = i == top - - --- | May need to change this to Traversal to be safe. For now it will fail when --- the main has not been properly set with. -mainModule :: Lens' SourceInfo ModDecl -mainModule = lens get_ set_ - where - set_ (SourceInfo top main) v = - SourceInfo top (main & getModule %~ update top v) - update top v m@(ModDecl (Identifier i) _ _ _ _) | i == top = v - | otherwise = m - get_ (SourceInfo top main) = head . filter (f top) $ main ^.. getModule - f top (ModDecl (Identifier i) _ _ _ _) = i == top -- cgit