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 +++--- src/VeriFuzz/Verilog/BitVec.hs | 4 ++-- src/VeriFuzz/Verilog/CodeGen.hs | 12 ++++++------ src/VeriFuzz/Verilog/Eval.hs | 14 +++++++------- src/VeriFuzz/Verilog/Internal.hs | 8 ++++---- src/VeriFuzz/Verilog/Lex.x | 4 ++-- src/VeriFuzz/Verilog/Mutate.hs | 28 ++++++++++++++-------------- src/VeriFuzz/Verilog/Parser.hs | 38 +++++++++++++++++++------------------- src/VeriFuzz/Verilog/Preprocess.hs | 4 ++-- src/VeriFuzz/Verilog/Quote.hs | 6 +++--- src/VeriFuzz/Verilog/Token.hs | 4 ++-- 11 files changed, 64 insertions(+), 64 deletions(-) (limited to 'src/VeriFuzz/Verilog') 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, diff --git a/src/VeriFuzz/Verilog/BitVec.hs b/src/VeriFuzz/Verilog/BitVec.hs index 0cc9eb3..dab9e2c 100644 --- a/src/VeriFuzz/Verilog/BitVec.hs +++ b/src/VeriFuzz/Verilog/BitVec.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.BitVec +Module : VeriSmith.Verilog.BitVec Description : Unsigned BitVec implementation. Copyright : (c) 2019, Yann Herklotz Grave License : GPL-3 @@ -17,7 +17,7 @@ Unsigned BitVec implementation. {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} -module VeriFuzz.Verilog.BitVec +module VeriSmith.Verilog.BitVec ( BitVecF(..) , BitVec , bitVec diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs index 56e2819..1e94472 100644 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.CodeGen +Module : VeriSmith.Verilog.CodeGen Description : Code generation for Verilog AST. Copyright : (c) 2018-2019, Yann Herklotz License : BSD-3 @@ -8,13 +8,13 @@ Stability : experimental Portability : POSIX This module generates the code from the Verilog AST defined in -"VeriFuzz.Verilog.AST". +"VeriSmith.Verilog.AST". -} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} -module VeriFuzz.Verilog.CodeGen +module VeriSmith.Verilog.CodeGen ( -- * Code Generation GenVerilog(..) , Source(..) @@ -28,9 +28,9 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Text.Prettyprint.Doc import Numeric (showHex) -import VeriFuzz.Internal hiding (comma) -import VeriFuzz.Verilog.AST -import VeriFuzz.Verilog.BitVec +import VeriSmith.Internal hiding (comma) +import VeriSmith.Verilog.AST +import VeriSmith.Verilog.BitVec -- | '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 diff --git a/src/VeriFuzz/Verilog/Eval.hs b/src/VeriFuzz/Verilog/Eval.hs index c802267..1ebaa80 100644 --- a/src/VeriFuzz/Verilog/Eval.hs +++ b/src/VeriFuzz/Verilog/Eval.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Eval +Module : VeriSmith.Verilog.Eval Description : Evaluation of Verilog expressions and statements. Copyright : (c) 2019, Yann Herklotz Grave License : GPL-3 @@ -10,18 +10,18 @@ Portability : POSIX Evaluation of Verilog expressions and statements. -} -module VeriFuzz.Verilog.Eval +module VeriSmith.Verilog.Eval ( evaluateConst , resize ) where import Data.Bits -import Data.Foldable (fold) -import Data.Functor.Foldable hiding (fold) -import Data.Maybe (listToMaybe) -import VeriFuzz.Verilog.AST -import VeriFuzz.Verilog.BitVec +import Data.Foldable (fold) +import Data.Functor.Foldable hiding (fold) +import Data.Maybe (listToMaybe) +import VeriSmith.Verilog.AST +import VeriSmith.Verilog.BitVec type Bindings = [Parameter] diff --git a/src/VeriFuzz/Verilog/Internal.hs b/src/VeriFuzz/Verilog/Internal.hs index 42eb4e2..ed91b12 100644 --- a/src/VeriFuzz/Verilog/Internal.hs +++ b/src/VeriFuzz/Verilog/Internal.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Internal +Module : VeriSmith.Verilog.Internal Description : Defaults and common functions. Copyright : (c) 2018-2019, Yann Herklotz License : BSD-3 @@ -10,7 +10,7 @@ Portability : POSIX Defaults and common functions. -} -module VeriFuzz.Verilog.Internal +module VeriSmith.Verilog.Internal ( regDecl , wireDecl , emptyMod @@ -29,8 +29,8 @@ module VeriFuzz.Verilog.Internal where import Control.Lens -import Data.Text (Text) -import VeriFuzz.Verilog.AST +import Data.Text (Text) +import VeriSmith.Verilog.AST regDecl :: Identifier -> ModItem regDecl i = Decl Nothing (Port Reg False (Range 1 0) i) Nothing diff --git a/src/VeriFuzz/Verilog/Lex.x b/src/VeriFuzz/Verilog/Lex.x index cc67ecc..3d1dd8d 100644 --- a/src/VeriFuzz/Verilog/Lex.x +++ b/src/VeriFuzz/Verilog/Lex.x @@ -1,11 +1,11 @@ -- -*- haskell -*- { {-# OPTIONS_GHC -w #-} -module VeriFuzz.Verilog.Lex +module VeriSmith.Verilog.Lex ( alexScanTokens ) where -import VeriFuzz.Verilog.Token +import VeriSmith.Verilog.Token } diff --git a/src/VeriFuzz/Verilog/Mutate.hs b/src/VeriFuzz/Verilog/Mutate.hs index 37d3a7d..58675e3 100644 --- a/src/VeriFuzz/Verilog/Mutate.hs +++ b/src/VeriFuzz/Verilog/Mutate.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Mutate +Module : VeriSmith.Verilog.Mutate Description : Functions to mutate the Verilog AST. Copyright : (c) 2018-2019, Yann Herklotz License : BSD-3 @@ -7,13 +7,13 @@ Maintainer : yann [at] yannherklotz [dot] com Stability : experimental Portability : POSIX -Functions to mutate the Verilog AST from "VeriFuzz.Verilog.AST" to generate more +Functions to mutate the Verilog AST from "VeriSmith.Verilog.AST" to generate more random patterns, such as nesting wires instead of creating new ones. -} {-# LANGUAGE FlexibleInstances #-} -module VeriFuzz.Verilog.Mutate +module VeriSmith.Verilog.Mutate ( Mutate(..) , inPort , findAssign @@ -41,16 +41,16 @@ module VeriFuzz.Verilog.Mutate 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.BitVec -import VeriFuzz.Verilog.CodeGen -import VeriFuzz.Verilog.Internal +import Data.Foldable (fold) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import VeriSmith.Circuit.Internal +import VeriSmith.Internal +import VeriSmith.Verilog.AST +import VeriSmith.Verilog.BitVec +import VeriSmith.Verilog.CodeGen +import VeriSmith.Verilog.Internal class Mutate a where mutExpr :: (Expr -> Expr) -> a -> a @@ -210,7 +210,7 @@ allVars m = <> (m ^.. modInPorts . traverse . portName) -- $setup --- >>> import VeriFuzz.Verilog.CodeGen +-- >>> import VeriSmith.Verilog.CodeGen -- >>> let m = (ModDecl (Identifier "m") [Port Wire False 5 (Identifier "y")] [Port Wire False 5 "x"] [] []) -- >>> let main = (ModDecl "main" [] [] [] []) diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs index c08ebcd..8d2b729 100644 --- a/src/VeriFuzz/Verilog/Parser.hs +++ b/src/VeriFuzz/Verilog/Parser.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Parser +Module : VeriSmith.Verilog.Parser Description : Minimal Verilog parser to reconstruct the AST. Copyright : (c) 2019, Yann Herklotz License : GPL-3 @@ -11,7 +11,7 @@ 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 +module VeriSmith.Verilog.Parser ( -- * Parser parseVerilog , parseVerilogFile @@ -26,25 +26,25 @@ module VeriFuzz.Verilog.Parser where import Control.Lens -import Control.Monad (void) -import Data.Bifunctor (bimap) +import Control.Monad (void) +import Data.Bifunctor (bimap) import Data.Bits -import Data.Functor (($>)) -import Data.Functor.Identity (Identity) -import Data.List (isInfixOf, isPrefixOf, null) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Text.Parsec hiding (satisfy) +import Data.Functor (($>)) +import Data.Functor.Identity (Identity) +import Data.List (isInfixOf, isPrefixOf, null) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Text.Parsec hiding (satisfy) import Text.Parsec.Expr -import VeriFuzz.Internal -import VeriFuzz.Verilog.AST -import VeriFuzz.Verilog.BitVec -import VeriFuzz.Verilog.Internal -import VeriFuzz.Verilog.Lex -import VeriFuzz.Verilog.Preprocess -import VeriFuzz.Verilog.Token +import VeriSmith.Internal +import VeriSmith.Verilog.AST +import VeriSmith.Verilog.BitVec +import VeriSmith.Verilog.Internal +import VeriSmith.Verilog.Lex +import VeriSmith.Verilog.Preprocess +import VeriSmith.Verilog.Token type Parser = Parsec [Token] () diff --git a/src/VeriFuzz/Verilog/Preprocess.hs b/src/VeriFuzz/Verilog/Preprocess.hs index c783ac5..c30252b 100644 --- a/src/VeriFuzz/Verilog/Preprocess.hs +++ b/src/VeriFuzz/Verilog/Preprocess.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Preprocess +Module : VeriSmith.Verilog.Preprocess Description : Simple preprocessor for `define and comments. Copyright : (c) 2011-2015 Tom Hawkins, 2019 Yann Herklotz License : GPL-3 @@ -14,7 +14,7 @@ The code is from https://github.com/tomahawkins/verilog. Edits to the original code are warning fixes and formatting changes. -} -module VeriFuzz.Verilog.Preprocess +module VeriSmith.Verilog.Preprocess ( uncomment , preprocess ) diff --git a/src/VeriFuzz/Verilog/Quote.hs b/src/VeriFuzz/Verilog/Quote.hs index c6d3e3c..3815fe6 100644 --- a/src/VeriFuzz/Verilog/Quote.hs +++ b/src/VeriFuzz/Verilog/Quote.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Quote +Module : VeriSmith.Verilog.Quote Description : QuasiQuotation for verilog code in Haskell. Copyright : (c) 2019, Yann Herklotz Grave License : GPL-3 @@ -12,7 +12,7 @@ QuasiQuotation for verilog code in Haskell. {-# LANGUAGE TemplateHaskell #-} -module VeriFuzz.Verilog.Quote +module VeriSmith.Verilog.Quote ( verilog ) where @@ -22,7 +22,7 @@ import qualified Data.Text as T import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax -import VeriFuzz.Verilog.Parser +import VeriSmith.Verilog.Parser liftDataWithText :: Data a => a -> Q Exp liftDataWithText = dataToExpQ $ fmap liftText . cast diff --git a/src/VeriFuzz/Verilog/Token.hs b/src/VeriFuzz/Verilog/Token.hs index d69f0b3..590672e 100644 --- a/src/VeriFuzz/Verilog/Token.hs +++ b/src/VeriFuzz/Verilog/Token.hs @@ -1,5 +1,5 @@ {-| -Module : VeriFuzz.Verilog.Token +Module : VeriSmith.Verilog.Token Description : Tokens for Verilog parsing. Copyright : (c) 2019, Yann Herklotz Grave License : GPL-3 @@ -10,7 +10,7 @@ Portability : POSIX Tokens for Verilog parsing. -} -module VeriFuzz.Verilog.Token +module VeriSmith.Verilog.Token ( Token(..) , TokenName(..) , Position(..) -- 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 ------------------------------------- src/VeriFuzz/Verilog/BitVec.hs | 119 -------- src/VeriFuzz/Verilog/CodeGen.hs | 341 ---------------------- src/VeriFuzz/Verilog/Eval.hs | 119 -------- src/VeriFuzz/Verilog/Internal.hs | 93 ------ src/VeriFuzz/Verilog/Lex.x | 188 ------------ src/VeriFuzz/Verilog/Mutate.hs | 401 ------------------------- src/VeriFuzz/Verilog/Parser.hs | 511 -------------------------------- src/VeriFuzz/Verilog/Preprocess.hs | 111 ------- src/VeriFuzz/Verilog/Quote.hs | 50 ---- src/VeriFuzz/Verilog/Token.hs | 350 ---------------------- 11 files changed, 2866 deletions(-) delete mode 100644 src/VeriFuzz/Verilog/AST.hs delete mode 100644 src/VeriFuzz/Verilog/BitVec.hs delete mode 100644 src/VeriFuzz/Verilog/CodeGen.hs delete mode 100644 src/VeriFuzz/Verilog/Eval.hs delete mode 100644 src/VeriFuzz/Verilog/Internal.hs delete mode 100644 src/VeriFuzz/Verilog/Lex.x delete mode 100644 src/VeriFuzz/Verilog/Mutate.hs delete mode 100644 src/VeriFuzz/Verilog/Parser.hs delete mode 100644 src/VeriFuzz/Verilog/Preprocess.hs delete mode 100644 src/VeriFuzz/Verilog/Quote.hs delete 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 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 diff --git a/src/VeriFuzz/Verilog/BitVec.hs b/src/VeriFuzz/Verilog/BitVec.hs deleted file mode 100644 index dab9e2c..0000000 --- a/src/VeriFuzz/Verilog/BitVec.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-| -Module : VeriSmith.Verilog.BitVec -Description : Unsigned BitVec implementation. -Copyright : (c) 2019, Yann Herklotz Grave -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Unsigned BitVec implementation. --} - -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} - -module VeriSmith.Verilog.BitVec - ( BitVecF(..) - , BitVec - , bitVec - , select - ) -where - -import Control.DeepSeq (NFData) -import Data.Bits -import Data.Data -import Data.Ratio -import GHC.Generics (Generic) - --- | Bit Vector that stores the bits in an arbitrary container together with the --- size. -data BitVecF a = BitVec { width :: {-# UNPACK #-} !Int - , value :: !a - } - deriving (Show, Eq, Ord, Data, Functor, Foldable, Traversable, Generic, NFData) - --- | Specialisation of the above with Integer, so that infinitely large bit --- vectors can be stored. -type BitVec = BitVecF Integer - -instance (Enum a) => Enum (BitVecF a) where - toEnum i = BitVec (width' $ fromIntegral i) $ toEnum i - fromEnum (BitVec _ v) = fromEnum v - -instance (Num a, Bits a) => Num (BitVecF a) where - BitVec w1 v1 + BitVec w2 v2 = bitVec (max w1 w2) (v1 + v2) - BitVec w1 v1 - BitVec w2 v2 = bitVec (max w1 w2) (v1 - v2) - BitVec w1 v1 * BitVec w2 v2 = bitVec (max w1 w2) (v1 * v2) - abs = id - signum (BitVec _ v) = if v == 0 then bitVec 1 0 else bitVec 1 1 - fromInteger i = bitVec (width' i) $ fromInteger i - -instance (Integral a, Bits a) => Real (BitVecF a) where - toRational (BitVec _ n) = fromIntegral n % 1 - -instance (Integral a, Bits a) => Integral (BitVecF a) where - quotRem (BitVec w1 v1) (BitVec w2 v2) = both (BitVec $ max w1 w2) $ quotRem v1 v2 - toInteger (BitVec _ v) = toInteger v - -instance (Num a, Bits a) => Bits (BitVecF a) where - BitVec w1 v1 .&. BitVec w2 v2 = bitVec (max w1 w2) (v1 .&. v2) - BitVec w1 v1 .|. BitVec w2 v2 = bitVec (max w1 w2) (v1 .|. v2) - BitVec w1 v1 `xor` BitVec w2 v2 = bitVec (max w1 w2) (v1 `xor` v2) - complement (BitVec w v) = bitVec w $ complement v - shift (BitVec w v) i = bitVec w $ shift v i - rotate = rotateBitVec - bit i = fromInteger $ bit i - testBit (BitVec _ v) = testBit v - bitSize (BitVec w _) = w - bitSizeMaybe (BitVec w _) = Just w - isSigned _ = False - popCount (BitVec _ v) = popCount v - -instance (Num a, Bits a) => FiniteBits (BitVecF a) where - finiteBitSize (BitVec w _) = w - -instance Bits a => Semigroup (BitVecF a) where - (BitVec w1 v1) <> (BitVec w2 v2) = BitVec (w1 + w2) (shiftL v1 w2 .|. v2) - -instance Bits a => Monoid (BitVecF a) where - mempty = BitVec 0 zeroBits - --- | BitVecF construction, given width and value. -bitVec :: (Num a, Bits a) => Int -> a -> BitVecF a -bitVec w v = BitVec w' $ v .&. ((2 ^ w') - 1) where w' = max w 0 - --- | Bit selection. LSB is 0. -select - :: (Integral a, Bits a, Integral b, Bits b) - => BitVecF a - -> (BitVecF b, BitVecF b) - -> BitVecF a -select (BitVec _ v) (msb, lsb) = - bitVec (from $ msb - lsb + 1) . shiftR (fromIntegral v) $ from lsb - where from = fromIntegral . value - --- | Rotate bits in a 'BitVec'. -rotateBitVec :: (Num a, Bits a) => BitVecF a -> Int -> BitVecF a -rotateBitVec b@(BitVec s _) n | n >= 0 = iterate rotateL1 b !! n - | otherwise = iterate rotateR1 b !! abs n - where - rotateR1 n' = testBits 0 (s - 1) n' .|. shiftR n' 1 - rotateL1 n' = testBits (s - 1) 0 n' .|. shiftL n' 1 - testBits a b' n' = if testBit n' a then bit b' else zeroBits - -width' :: Integer -> Int -width' a | a == 0 = 1 - | otherwise = width'' a - where - width'' a' | a' == 0 = 0 - | a' == -1 = 1 - | otherwise = 1 + width'' (shiftR a' 1) - -both :: (a -> b) -> (a, a) -> (b, b) -both f (a, b) = (f a, f b) diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs deleted file mode 100644 index 1e94472..0000000 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ /dev/null @@ -1,341 +0,0 @@ -{-| -Module : VeriSmith.Verilog.CodeGen -Description : Code generation for Verilog AST. -Copyright : (c) 2018-2019, Yann Herklotz -License : BSD-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -This module generates the code from the Verilog AST defined in -"VeriSmith.Verilog.AST". --} - -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} - -module VeriSmith.Verilog.CodeGen - ( -- * Code Generation - GenVerilog(..) - , Source(..) - , render - ) -where - -import Data.Data (Data) -import Data.List.NonEmpty (NonEmpty (..), toList) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Prettyprint.Doc -import Numeric (showHex) -import VeriSmith.Internal hiding (comma) -import VeriSmith.Verilog.AST -import VeriSmith.Verilog.BitVec - --- | '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 -> Doc a -defMap = maybe semi statement - --- | Convert the 'Verilog' type to 'Text' so that it can be rendered. -verilogSrc :: Verilog -> Doc a -verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules - --- | Generate the 'ModDecl' for a module and convert it to 'Text'. -moduleDecl :: ModDecl -> Doc a -moduleDecl (ModDecl i outP inP items ps) = vsep - [ sep ["module" <+> identifier i, params ps, ports <> semi] - , indent 2 modI - , "endmodule" - ] - where - ports - | null outP && null inP = "" - | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn - modI = vsep $ moduleItem <$> items - outIn = outP ++ inP - params [] = "" - params (p : pps) = hcat ["#", paramList (p :| pps)] - --- | Generates a parameter list. Can only be called with a 'NonEmpty' list. -paramList :: NonEmpty Parameter -> Doc a -paramList ps = tupled . toList $ parameter <$> ps - --- | Generates a localparam list. Can only be called with a 'NonEmpty' list. -localParamList :: NonEmpty LocalParam -> Doc a -localParamList ps = tupled . toList $ localParam <$> ps - --- | Generates the assignment for a 'Parameter'. -parameter :: Parameter -> Doc a -parameter (Parameter name val) = - hsep ["parameter", identifier name, "=", constExpr val] - --- | Generates the assignment for a 'LocalParam'. -localParam :: LocalParam -> Doc a -localParam (LocalParam name val) = - hsep ["localparameter", identifier name, "=", constExpr val] - -identifier :: Identifier -> Doc a -identifier (Identifier i) = pretty i - --- | Conversts 'Port' to 'Text' for the module list, which means it only --- generates a list of identifiers. -modPort :: Port -> Doc a -modPort (Port _ _ _ i) = identifier i - --- | Generate the 'Port' description. -port :: Port -> Doc a -port (Port tp sgn r name) = hsep [t, sign, range r, identifier name] - where - t = pType tp - sign = signed sgn - -range :: Range -> Doc a -range (Range msb lsb) = brackets $ hcat [constExpr msb, colon, constExpr lsb] - -signed :: Bool -> Doc a -signed True = "signed" -signed _ = mempty - --- | Convert the 'PortDir' type to 'Text'. -portDir :: PortDir -> Doc a -portDir PortIn = "input" -portDir PortOut = "output" -portDir PortInOut = "inout" - --- | Generate a 'ModItem'. -moduleItem :: ModItem -> Doc a -moduleItem (ModCA ca ) = contAssign ca -moduleItem (ModInst i name conn) = hsep - [ identifier i - , identifier name - , parens . hsep $ punctuate comma (mConn <$> conn) - , semi - ] -moduleItem (Initial stat ) = nest 2 $ vsep ["initial", statement stat] -moduleItem (Always stat ) = nest 2 $ vsep ["always", statement stat] -moduleItem (Decl dir p ini) = hsep - [maybe mempty makePort dir, port p, maybe mempty makeIni ini, semi] - where - makePort = portDir - makeIni = ("=" <+>) . constExpr -moduleItem (ParamDecl p) = hcat [paramList p, semi] -moduleItem (LocalParamDecl p) = hcat [localParamList p, semi] - -mConn :: ModConn -> Doc a -mConn (ModConn c ) = expr c -mConn (ModConnNamed n c) = hcat [dot, identifier n, parens $ expr c] - --- | Generate continuous assignment -contAssign :: ContAssign -> Doc a -contAssign (ContAssign val e) = - hsep ["assign", identifier val, "=", align $ expr e, semi] - --- | Generate 'Expr' to 'Text'. -expr :: Expr -> Doc a -expr (BinOp eRhs bin eLhs) = parens $ hsep [expr eRhs, binaryOp bin, expr eLhs] -expr (Number b ) = showNum b -expr (Id i ) = identifier i -expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e] -expr (RangeSelect i r ) = hcat [identifier i, range r] -expr (Concat c) = braces . nest 4 . sep . punctuate comma $ toList (expr <$> c) -expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e] -expr (Cond l t f) = - parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]] -expr (Appl f e) = hcat [identifier f, parens $ expr e] -expr (Str t ) = dquotes $ pretty t - -showNum :: BitVec -> Doc a -showNum (BitVec s n) = parens - $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")] - where - minus | signum n >= 0 = mempty - | otherwise = "-" - -constExpr :: ConstExpr -> Doc a -constExpr (ConstNum b) = showNum b -constExpr (ParamId i) = identifier i -constExpr (ConstConcat c) = - braces . hsep . punctuate comma $ toList (constExpr <$> c) -constExpr (ConstUnOp u e) = parens $ hcat [unaryOp u, constExpr e] -constExpr (ConstBinOp eRhs bin eLhs) = - parens $ hsep [constExpr eRhs, binaryOp bin, constExpr eLhs] -constExpr (ConstCond l t f) = - parens $ hsep [constExpr l, "?", constExpr t, colon, constExpr f] -constExpr (ConstStr t) = dquotes $ pretty t - --- | Convert 'BinaryOperator' to 'Text'. -binaryOp :: BinaryOperator -> Doc a -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 -> Doc a -unaryOp UnPlus = "+" -unaryOp UnMinus = "-" -unaryOp UnLNot = "!" -unaryOp UnNot = "~" -unaryOp UnAnd = "&" -unaryOp UnNand = "~&" -unaryOp UnOr = "|" -unaryOp UnNor = "~|" -unaryOp UnXor = "^" -unaryOp UnNxor = "~^" -unaryOp UnNxorInv = "^~" - -event :: Event -> Doc a -event a = hcat ["@", parens $ eventRec a] - --- | Generate verilog code for an 'Event'. -eventRec :: Event -> Doc a -eventRec (EId i) = identifier i -eventRec (EExpr e) = expr e -eventRec EAll = "*" -eventRec (EPosEdge i) = hsep ["posedge", identifier i] -eventRec (ENegEdge i) = hsep ["negedge", identifier i] -eventRec (EOr a b ) = hsep [eventRec a, "or", eventRec b] -eventRec (EComb a b ) = hsep $ punctuate comma [eventRec a, eventRec b] - --- | Generates verilog code for a 'Delay'. -delay :: Delay -> Doc a -delay (Delay i) = "#" <> pretty i - --- | Generate the verilog code for an 'LVal'. -lVal :: LVal -> Doc a -lVal (RegId i ) = identifier i -lVal (RegExpr i e) = hsep [identifier i, expr e] -lVal (RegSize i r) = hsep [identifier i, range r] -lVal (RegConcat e) = braces . hsep $ punctuate comma (expr <$> e) - -pType :: PortType -> Doc a -pType Wire = "wire" -pType Reg = "reg" - -genAssign :: Text -> Assign -> Doc a -genAssign op (Assign r d e) = - hsep [lVal r, pretty op, maybe mempty delay d, expr e] - -statement :: Statement -> Doc a -statement (TimeCtrl d stat) = hsep [delay d, defMap stat] -statement (EventCtrl e stat) = hsep [event e, defMap stat] -statement (SeqBlock s) = - vsep ["begin", indent 2 . vsep $ statement <$> s, "end"] -statement (BlockAssign a) = hcat [genAssign "=" a, semi] -statement (NonBlockAssign a) = hcat [genAssign "<=" a, semi] -statement (TaskEnable t) = hcat [task t, semi] -statement (SysTaskEnable t) = hcat ["$", task t, semi] -statement (CondStmnt e t Nothing) = - vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t] -statement (CondStmnt e t f) = vsep - [ hsep ["if", parens $ expr e] - , indent 2 $ defMap t - , "else" - , indent 2 $ defMap f - ] -statement (ForLoop a e incr stmnt) = vsep - [ hsep - [ "for" - , parens . hsep $ punctuate - semi - [genAssign "=" a, expr e, genAssign "=" incr] - ] - , indent 2 $ statement stmnt - ] - -task :: Task -> Doc a -task (Task i e) - | null e = identifier i - | otherwise = hsep - [identifier i, parens . hsep $ punctuate comma (expr <$> e)] - --- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. -render :: (Source a) => a -> IO () -render = print . genSource - --- Instances - -instance Source Identifier where - genSource = showT . identifier - -instance Source Task where - genSource = showT . task - -instance Source Statement where - genSource = showT . statement - -instance Source PortType where - genSource = showT . pType - -instance Source ConstExpr where - genSource = showT . constExpr - -instance Source LVal where - genSource = showT . lVal - -instance Source Delay where - genSource = showT . delay - -instance Source Event where - genSource = showT . event - -instance Source UnaryOperator where - genSource = showT . unaryOp - -instance Source Expr where - genSource = showT . expr - -instance Source ContAssign where - genSource = showT . contAssign - -instance Source ModItem where - genSource = showT . moduleItem - -instance Source PortDir where - genSource = showT . portDir - -instance Source Port where - genSource = showT . port - -instance Source ModDecl where - genSource = showT . moduleDecl - -instance Source Verilog where - genSource = showT . verilogSrc - -instance Source SourceInfo where - genSource (SourceInfo _ src) = genSource src - -newtype GenVerilog a = GenVerilog { unGenVerilog :: a } - deriving (Eq, Ord, Data) - -instance (Source a) => Show (GenVerilog a) where - show = T.unpack . genSource . unGenVerilog diff --git a/src/VeriFuzz/Verilog/Eval.hs b/src/VeriFuzz/Verilog/Eval.hs deleted file mode 100644 index 1ebaa80..0000000 --- a/src/VeriFuzz/Verilog/Eval.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Eval -Description : Evaluation of Verilog expressions and statements. -Copyright : (c) 2019, Yann Herklotz Grave -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Evaluation of Verilog expressions and statements. --} - -module VeriSmith.Verilog.Eval - ( evaluateConst - , resize - ) -where - -import Data.Bits -import Data.Foldable (fold) -import Data.Functor.Foldable hiding (fold) -import Data.Maybe (listToMaybe) -import VeriSmith.Verilog.AST -import VeriSmith.Verilog.BitVec - -type Bindings = [Parameter] - -paramIdent_ :: Parameter -> Identifier -paramIdent_ (Parameter i _) = i - -paramValue_ :: Parameter -> ConstExpr -paramValue_ (Parameter _ v) = v - -applyUnary :: (Num a, FiniteBits a) => UnaryOperator -> a -> a -applyUnary UnPlus a = a -applyUnary UnMinus a = negate a -applyUnary UnLNot a | a == 0 = 0 - | otherwise = 1 -applyUnary UnNot a = complement a -applyUnary UnAnd a | finiteBitSize a == popCount a = 1 - | otherwise = 0 -applyUnary UnNand a | finiteBitSize a == popCount a = 0 - | otherwise = 1 -applyUnary UnOr a | popCount a == 0 = 0 - | otherwise = 1 -applyUnary UnNor a | popCount a == 0 = 1 - | otherwise = 0 -applyUnary UnXor a | popCount a `mod` 2 == 0 = 0 - | otherwise = 1 -applyUnary UnNxor a | popCount a `mod` 2 == 0 = 1 - | otherwise = 0 -applyUnary UnNxorInv a | popCount a `mod` 2 == 0 = 1 - | otherwise = 0 - -compXor :: Bits c => c -> c -> c -compXor a = complement . xor a - -toIntegral :: Num p => (t1 -> t2 -> Bool) -> t1 -> t2 -> p -toIntegral a b c = if a b c then 1 else 0 - -toInt :: (Integral a, Num t1) => (t2 -> t1 -> t3) -> t2 -> a -> t3 -toInt a b c = a b $ fromIntegral c - -applyBinary :: (Integral a, Bits a) => BinaryOperator -> a -> a -> a -applyBinary BinPlus = (+) -applyBinary BinMinus = (-) -applyBinary BinTimes = (*) -applyBinary BinDiv = quot -applyBinary BinMod = rem -applyBinary BinEq = toIntegral (==) -applyBinary BinNEq = toIntegral (/=) -applyBinary BinCEq = toIntegral (==) -applyBinary BinCNEq = toIntegral (/=) -applyBinary BinLAnd = undefined -applyBinary BinLOr = undefined -applyBinary BinLT = toIntegral (<) -applyBinary BinLEq = toIntegral (<=) -applyBinary BinGT = toIntegral (>) -applyBinary BinGEq = toIntegral (>=) -applyBinary BinAnd = (.&.) -applyBinary BinOr = (.|.) -applyBinary BinXor = xor -applyBinary BinXNor = compXor -applyBinary BinXNorInv = compXor -applyBinary BinPower = undefined -applyBinary BinLSL = toInt shiftL -applyBinary BinLSR = toInt shiftR -applyBinary BinASL = toInt shiftL -applyBinary BinASR = toInt shiftR - --- | Evaluates a 'ConstExpr' using a context of 'Bindings' as input. -evaluateConst :: Bindings -> ConstExprF BitVec -> BitVec -evaluateConst _ (ConstNumF b) = b -evaluateConst p (ParamIdF i) = - cata (evaluateConst p) . maybe 0 paramValue_ . listToMaybe $ filter - ((== i) . paramIdent_) - p -evaluateConst _ (ConstConcatF c ) = fold c -evaluateConst _ (ConstUnOpF unop c ) = applyUnary unop c -evaluateConst _ (ConstBinOpF a binop b) = applyBinary binop a b -evaluateConst _ (ConstCondF a b c) = if a > 0 then b else c -evaluateConst _ (ConstStrF _ ) = 0 - --- | Apply a function to all the bitvectors. Would be fixed by having a --- 'Functor' instance for a polymorphic 'ConstExpr'. -applyBitVec :: (BitVec -> BitVec) -> ConstExpr -> ConstExpr -applyBitVec f (ConstNum b ) = ConstNum $ f b -applyBitVec f (ConstConcat c ) = ConstConcat $ fmap (applyBitVec f) c -applyBitVec f (ConstUnOp unop c) = ConstUnOp unop $ applyBitVec f c -applyBitVec f (ConstBinOp a binop b) = - ConstBinOp (applyBitVec f a) binop (applyBitVec f b) -applyBitVec f (ConstCond a b c) = ConstCond (abv a) (abv b) (abv c) - where abv = applyBitVec f -applyBitVec _ a = a - --- | This probably could be implemented using some recursion scheme in the --- future. It would also be fixed by having a polymorphic expression type. -resize :: Int -> ConstExpr -> ConstExpr -resize n = applyBitVec (resize' n) where resize' n' (BitVec _ a) = BitVec n' a diff --git a/src/VeriFuzz/Verilog/Internal.hs b/src/VeriFuzz/Verilog/Internal.hs deleted file mode 100644 index ed91b12..0000000 --- a/src/VeriFuzz/Verilog/Internal.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Internal -Description : Defaults and common functions. -Copyright : (c) 2018-2019, Yann Herklotz -License : BSD-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Defaults and common functions. --} - -module VeriSmith.Verilog.Internal - ( regDecl - , wireDecl - , emptyMod - , setModName - , addModPort - , addModDecl - , testBench - , addTestBench - , defaultPort - , portToExpr - , modName - , yPort - , wire - , reg - ) -where - -import Control.Lens -import Data.Text (Text) -import VeriSmith.Verilog.AST - -regDecl :: Identifier -> ModItem -regDecl i = Decl Nothing (Port Reg False (Range 1 0) i) Nothing - -wireDecl :: Identifier -> ModItem -wireDecl i = Decl Nothing (Port Wire False (Range 1 0) i) Nothing - --- | 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 - -addModDecl :: ModDecl -> Verilog -> Verilog -addModDecl desc = _Wrapped %~ (:) 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 - , BlockAssign . Assign (RegId "b") Nothing $ Number 1 - ] - ] - [] - -addTestBench :: Verilog -> Verilog -addTestBench = addModDecl testBench - -defaultPort :: Identifier -> Port -defaultPort = Port Wire False (Range 1 0) - -portToExpr :: Port -> Expr -portToExpr (Port _ _ _ i) = Id i - -modName :: ModDecl -> Text -modName = getIdentifier . view modId - -yPort :: Identifier -> Port -yPort = Port Wire False (Range 90 0) - -wire :: Range -> Identifier -> Port -wire = Port Wire False - -reg :: Range -> Identifier -> Port -reg = Port Reg False diff --git a/src/VeriFuzz/Verilog/Lex.x b/src/VeriFuzz/Verilog/Lex.x deleted file mode 100644 index 3d1dd8d..0000000 --- a/src/VeriFuzz/Verilog/Lex.x +++ /dev/null @@ -1,188 +0,0 @@ --- -*- haskell -*- -{ -{-# OPTIONS_GHC -w #-} -module VeriSmith.Verilog.Lex - ( alexScanTokens - ) where - -import VeriSmith.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 deleted file mode 100644 index 58675e3..0000000 --- a/src/VeriFuzz/Verilog/Mutate.hs +++ /dev/null @@ -1,401 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Mutate -Description : Functions to mutate the Verilog AST. -Copyright : (c) 2018-2019, Yann Herklotz -License : BSD-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Functions to mutate the Verilog AST from "VeriSmith.Verilog.AST" to generate more -random patterns, such as nesting wires instead of creating new ones. --} - -{-# LANGUAGE FlexibleInstances #-} - -module VeriSmith.Verilog.Mutate - ( Mutate(..) - , inPort - , findAssign - , idTrans - , replace - , nestId - , nestSource - , nestUpTo - , allVars - , instantiateMod - , instantiateMod_ - , instantiateModSpec_ - , filterChar - , initMod - , makeIdFrom - , makeTop - , makeTopAssert - , simplify - , removeId - , combineAssigns - , combineAssigns_ - , declareMod - , fromPort - ) -where - -import Control.Lens -import Data.Foldable (fold) -import Data.Maybe (catMaybes, fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import VeriSmith.Circuit.Internal -import VeriSmith.Internal -import VeriSmith.Verilog.AST -import VeriSmith.Verilog.BitVec -import VeriSmith.Verilog.CodeGen -import VeriSmith.Verilog.Internal - -class Mutate a where - mutExpr :: (Expr -> Expr) -> a -> a - -instance Mutate Identifier where - mutExpr _ = id - -instance Mutate Delay where - mutExpr _ = id - -instance Mutate Event where - mutExpr f (EExpr e) = EExpr $ f e - mutExpr _ a = a - -instance Mutate BinaryOperator where - mutExpr _ = id - -instance Mutate UnaryOperator where - mutExpr _ = id - -instance Mutate Expr where - mutExpr f = f - -instance Mutate ConstExpr where - mutExpr _ = id - -instance Mutate Task where - mutExpr f (Task i e) = Task i $ fmap f e - -instance Mutate LVal where - mutExpr f (RegExpr a e) = RegExpr a $ f e - mutExpr _ a = a - -instance Mutate PortDir where - mutExpr _ = id - -instance Mutate PortType where - mutExpr _ = id - -instance Mutate Range where - mutExpr _ = id - -instance Mutate Port where - mutExpr _ = id - -instance Mutate ModConn where - mutExpr f (ModConn e) = ModConn $ f e - mutExpr f (ModConnNamed a e) = ModConnNamed a $ f e - -instance Mutate Assign where - mutExpr f (Assign a b c) = Assign a b $ f c - -instance Mutate ContAssign where - mutExpr f (ContAssign a e) = ContAssign a $ f e - -instance Mutate Statement where - mutExpr f (TimeCtrl d s) = TimeCtrl d $ mutExpr f <$> s - mutExpr f (EventCtrl e s) = EventCtrl e $ mutExpr f <$> s - mutExpr f (SeqBlock s) = SeqBlock $ mutExpr f <$> s - mutExpr f (BlockAssign a) = BlockAssign $ mutExpr f a - mutExpr f (NonBlockAssign a) = NonBlockAssign $ mutExpr f a - mutExpr f (TaskEnable a) = TaskEnable $ mutExpr f a - mutExpr f (SysTaskEnable a) = SysTaskEnable $ mutExpr f a - mutExpr f (CondStmnt a b c) = CondStmnt (f a) (mutExpr f <$> b) $ mutExpr f <$> c - mutExpr f (ForLoop a1 e a2 s) = ForLoop (mutExpr f a1) (f e) (mutExpr f a2) $ mutExpr f s - -instance Mutate Parameter where - mutExpr _ = id - -instance Mutate LocalParam where - mutExpr _ = id - -instance Mutate ModItem where - mutExpr f (ModCA (ContAssign a e)) = ModCA . ContAssign a $ f e - mutExpr f (ModInst a b conns) = ModInst a b $ mutExpr f conns - mutExpr f (Initial s) = Initial $ mutExpr f s - mutExpr f (Always s) = Always $ mutExpr f s - mutExpr _ d@Decl{} = d - mutExpr _ p@ParamDecl{} = p - mutExpr _ l@LocalParamDecl{} = l - -instance Mutate ModDecl where - mutExpr f (ModDecl a b c d e) = ModDecl (mutExpr f a) (mutExpr f b) (mutExpr f c) (mutExpr f d) (mutExpr f e) - -instance Mutate Verilog where - mutExpr f (Verilog a) = Verilog $ mutExpr f a - -instance Mutate SourceInfo where - mutExpr f (SourceInfo a b) = SourceInfo a $ mutExpr f b - -instance Mutate a => Mutate [a] where - mutExpr f a = mutExpr f <$> a - -instance Mutate a => Mutate (Maybe a) where - mutExpr f a = mutExpr f <$> a - -instance Mutate a => Mutate (GenVerilog a) where - mutExpr f (GenVerilog a) = GenVerilog $ mutExpr f a - --- | 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 = (transform .) . 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 VeriSmith.Verilog.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 [(3'h4):(1'h0)] y; --- reg [(3'h4):(1'h0)] x; --- m m1(y, x); --- endmodule --- --- -instantiateMod :: ModDecl -> ModDecl -> ModDecl -instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) - where - out = Decl Nothing <$> m ^. modOutPorts <*> pure Nothing - regIn = - Decl Nothing - <$> (m ^. modInPorts & traverse . portType .~ Reg) - <*> pure Nothing - 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 . _Wrapped %~ (\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 [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- -initMod :: ModDecl -> ModDecl -initMod m = m & modItems %~ ((out ++ inp) ++) - where - out = Decl (Just PortOut) <$> (m ^. modOutPorts) <*> pure Nothing - inp = Decl (Just PortIn) <$> (m ^. modInPorts) <*> pure Nothing - --- | 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])) . makeTop 2 - where - assert = Always . EventCtrl e . Just $ SeqBlock - [TaskEnable $ Task "assert" [BinOp (Id "y_1") BinEq (Id "y_2")]] - e = EPosEdge "clk" - --- | Provide declarations for all the ports that are passed to it. If they are --- registers, it should assign them to 0. -declareMod :: [Port] -> ModDecl -> ModDecl -declareMod ports = initMod . (modItems %~ (fmap decl ports ++)) - where - decl p@(Port Reg _ _ _) = Decl Nothing p (Just 0) - decl p = Decl Nothing p Nothing - --- | 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 (BitVec _ 1)) BinAnd e) = e -simplify (BinOp e BinAnd (Number (BitVec _ 1))) = e -simplify (BinOp (Number (BitVec _ 0)) BinAnd _) = Number 0 -simplify (BinOp _ BinAnd (Number (BitVec _ 0))) = Number 0 -simplify (BinOp e BinPlus (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinPlus e) = e -simplify (BinOp e BinMinus (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinMinus e) = e -simplify (BinOp e BinTimes (Number (BitVec _ 1))) = e -simplify (BinOp (Number (BitVec _ 1)) BinTimes e) = e -simplify (BinOp _ BinTimes (Number (BitVec _ 0))) = Number 0 -simplify (BinOp (Number (BitVec _ 0)) BinTimes _) = Number 0 -simplify (BinOp e BinOr (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinOr e) = e -simplify (BinOp e BinLSL (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinLSL e) = e -simplify (BinOp e BinLSR (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinLSR e) = e -simplify (BinOp e BinASL (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinASL e) = e -simplify (BinOp e BinASR (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 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 0 - | otherwise = Id ident - trans e = e - -combineAssigns :: Port -> [ModItem] -> [ModItem] -combineAssigns p a = - a - <> [ ModCA - . ContAssign (p ^. portName) - . UnOp UnXor - . fold - $ Id - <$> assigns - ] - where assigns = a ^.. traverse . modContAssign . contAssignNetLVal - -combineAssigns_ :: Bool -> Port -> [Port] -> ModItem -combineAssigns_ comb p ps = - ModCA - . ContAssign (p ^. portName) - . (if comb then UnOp UnXor else id) - . fold - $ Id - <$> ps - ^.. traverse - . portName - -fromPort :: Port -> Identifier -fromPort (Port _ _ _ i) = i diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs deleted file mode 100644 index 8d2b729..0000000 --- a/src/VeriFuzz/Verilog/Parser.hs +++ /dev/null @@ -1,511 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Parser -Description : Minimal Verilog parser to reconstruct the AST. -Copyright : (c) 2019, Yann Herklotz -License : GPL-3 -Maintainer : yann [at] yannherklotz [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 VeriSmith.Verilog.Parser - ( -- * Parser - parseVerilog - , parseVerilogFile - , parseSourceInfoFile - -- ** Internal parsers - , parseEvent - , parseStatement - , parseModItem - , parseModDecl - , Parser - ) -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, null) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Text.Parsec hiding (satisfy) -import Text.Parsec.Expr -import VeriSmith.Internal -import VeriSmith.Verilog.AST -import VeriSmith.Verilog.BitVec -import VeriSmith.Verilog.Internal -import VeriSmith.Verilog.Lex -import VeriSmith.Verilog.Preprocess -import VeriSmith.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) - -brackets :: Parser a -> Parser a -brackets = between (tok SymBrackL) (tok SymBrackR) - -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 $ bitVec 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 - -parseVecSelect :: Parser Expr -parseVecSelect = do - i <- identifier - expr <- brackets parseExpr - return $ VecSelect i expr - -parseRangeSelect :: Parser Expr -parseRangeSelect = do - i <- identifier - range <- parseRange - return $ RangeSelect i range - -systemFunc :: Parser String -systemFunc = satisfy' matchId - where - matchId (Token IdSystem s _) = Just s - matchId _ = Nothing - -parseFun :: Parser Expr -parseFun = do - f <- systemFunc - expr <- parens parseExpr - return $ Appl (Identifier $ T.pack f) expr - -parserNonEmpty :: [a] -> Parser (NonEmpty a) -parserNonEmpty (a : b) = return $ a :| b -parserNonEmpty [] = fail "Concatenation cannot be empty." - -parseTerm :: Parser Expr -parseTerm = - parens parseExpr - <|> (Concat <$> (braces (commaSep parseExpr) >>= parserNonEmpty)) - <|> parseFun - <|> parseNum - <|> try parseVecSelect - <|> try parseRangeSelect - <|> 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 - -parseConstExpr :: Parser ConstExpr -parseConstExpr = fmap exprToConst parseExpr - --- | 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 - -toInt' :: Decimal -> Int -toInt' (Decimal _ n) = fromInteger n - --- | Parse a range and return the total size. As it is inclusive, 1 has to be --- added to the difference. -parseRange :: Parser Range -parseRange = do - rangeH <- tok SymBrackL *> parseConstExpr - rangeL <- tok SymColon *> parseConstExpr - tok' SymBrackR - return $ Range rangeH rangeL - -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 - i <- option Nothing (fmap Just (tok' SymEq *> parseConstExpr)) - tok' SymSemi - return $ Decl pd (Port t sign range name) i - 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 - -parseConditional :: Parser Statement -parseConditional = do - expr <- tok' KWIf *> parens parseExpr - true <- maybeEmptyStatement - false <- option Nothing (tok' KWElse *> maybeEmptyStatement) - return $ CondStmnt expr true false - -parseLVal :: Parser LVal -parseLVal = fmap RegConcat (braces $ commaSep parseExpr) <|> ident - where - ident = do - i <- identifier - (try (ex i) <|> try (sz i) <|> return (RegId i)) - ex i = do - e <- tok' SymBrackL *> parseExpr - tok' SymBrackR - return $ RegExpr i e - sz i = RegSize i <$> parseRange - -parseDelay :: Parser Delay -parseDelay = Delay . toInt' <$> (tok' SymPound *> number) - -parseAssign :: TokenName -> Parser Assign -parseAssign t = do - lval <- parseLVal - tok' t - delay <- option Nothing (fmap Just parseDelay) - expr <- parseExpr - return $ Assign lval delay expr - -parseLoop :: Parser Statement -parseLoop = do - a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq - expr <- tok' SymSemi *> parseExpr - incr <- tok' SymSemi *> parseAssign SymEq - tok' SymParenR - statement <- parseStatement - return $ ForLoop a expr incr statement - -eventList :: TokenName -> Parser [Event] -eventList t = do - l <- sepBy parseEvent' (tok t) - if null l then fail "Could not parse list" else return l - -parseEvent :: Parser Event -parseEvent = - tok' SymAtAster - $> EAll - <|> try (tok' SymAt *> tok' SymParenLAsterParenR $> EAll) - <|> try - ( tok' SymAt - *> tok' SymParenL - *> tok' SymAster - *> tok' SymParenR - $> EAll - ) - <|> try (tok' SymAt *> parens parseEvent') - <|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr)) - <|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma)) - -parseEvent' :: Parser Event -parseEvent' = - try (tok' KWPosedge *> fmap EPosEdge identifier) - <|> try (tok' KWNegedge *> fmap ENegEdge identifier) - <|> try (fmap EId identifier) - <|> try (fmap EExpr parseExpr) - -parseEventCtrl :: Parser Statement -parseEventCtrl = do - event <- parseEvent - statement <- option Nothing maybeEmptyStatement - return $ EventCtrl event statement - -parseDelayCtrl :: Parser Statement -parseDelayCtrl = do - delay <- parseDelay - statement <- option Nothing maybeEmptyStatement - return $ TimeCtrl delay statement - -parseBlocking :: Parser Statement -parseBlocking = do - a <- parseAssign SymEq - tok' SymSemi - return $ BlockAssign a - -parseNonBlocking :: Parser Statement -parseNonBlocking = do - a <- parseAssign SymLtEq - tok' SymSemi - return $ NonBlockAssign a - -parseSeq :: Parser Statement -parseSeq = do - seq' <- tok' KWBegin *> many parseStatement - tok' KWEnd - return $ SeqBlock seq' - -parseStatement :: Parser Statement -parseStatement = - parseSeq - <|> parseConditional - <|> parseLoop - <|> parseEventCtrl - <|> parseDelayCtrl - <|> try parseBlocking - <|> parseNonBlocking - -maybeEmptyStatement :: Parser (Maybe Statement) -maybeEmptyStatement = - (tok' SymSemi >> return Nothing) <|> (Just <$> parseStatement) - -parseAlways :: Parser ModItem -parseAlways = tok' KWAlways *> (Always <$> parseStatement) - -parseInitial :: Parser ModItem -parseInitial = tok' KWInitial *> (Initial <$> parseStatement) - -namedModConn :: Parser ModConn -namedModConn = do - target <- tok' SymDot *> identifier - expr <- parens parseExpr - return $ ModConnNamed target expr - -parseModConn :: Parser ModConn -parseModConn = try (fmap ModConn parseExpr) <|> namedModConn - -parseModInst :: Parser ModItem -parseModInst = do - m <- identifier - name <- identifier - modconns <- parens (commaSep parseModConn) - tok' SymSemi - return $ ModInst m name modconns - -parseModItem :: Parser ModItem -parseModItem = - try (ModCA <$> parseContAssign) - <|> try parseDecl - <|> parseAlways - <|> parseInitial - <|> parseModInst - -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 - -parseParam :: Parser Parameter -parseParam = do - i <- tok' KWParameter *> identifier - expr <- tok' SymEq *> parseConstExpr - return $ Parameter i expr - -parseParams :: Parser [Parameter] -parseParams = tok' SymPound *> parens (commaSep parseParam) - -parseModDecl :: Parser ModDecl -parseModDecl = do - name <- tok KWModule *> identifier - paramList <- option [] $ try parseParams - _ <- fmap defaultPort <$> parseModList - tok' SymSemi - modItem <- option [] . try $ many1 parseModItem - tok' KWEndmodule - return $ ModDecl name - (modPorts PortOut modItem) - (modPorts PortIn modItem) - modItem - paramList - --- | Parses a 'String' into 'Verilog' by skipping any beginning whitespace --- and then parsing multiple Verilog source. -parseVerilogSrc :: Parser Verilog -parseVerilogSrc = Verilog <$> many parseModDecl - --- | Parse a 'String' containing verilog code. The parser currently only supports --- the subset of Verilog that is being generated randomly. -parseVerilog - :: Text -- ^ Name of parsed object. - -> Text -- ^ Content to be parsed. - -> Either Text Verilog -- ^ Returns 'String' with error - -- message if parse fails. -parseVerilog s = - bimap showT id - . parse parseVerilogSrc (T.unpack s) - . alexScanTokens - . preprocess [] (T.unpack s) - . T.unpack - -parseVerilogFile :: Text -> IO Verilog -parseVerilogFile file = do - src <- T.readFile $ T.unpack file - case parseVerilog file src of - Left s -> error $ T.unpack s - Right r -> return r - -parseSourceInfoFile :: Text -> Text -> IO SourceInfo -parseSourceInfoFile top = fmap (SourceInfo top) . parseVerilogFile diff --git a/src/VeriFuzz/Verilog/Preprocess.hs b/src/VeriFuzz/Verilog/Preprocess.hs deleted file mode 100644 index c30252b..0000000 --- a/src/VeriFuzz/Verilog/Preprocess.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Preprocess -Description : Simple preprocessor for `define and comments. -Copyright : (c) 2011-2015 Tom Hawkins, 2019 Yann Herklotz -License : GPL-3 -Maintainer : yann [at] yannherklotz [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 VeriSmith.Verilog.Preprocess - ( uncomment - , preprocess - ) -where - --- | Remove comments from code. There is no difference between @(* *)@ and --- @/* */@, therefore in this implementation, @*/@ could close @(*@ and vice-versa, --- This will be fixed in an upcoming version. -uncomment :: FilePath -> String -> String -uncomment file = uncomment' - where - uncomment' a = case a of - "" -> "" - '/' : '/' : rest -> " " ++ removeEOL rest - '/' : '*' : rest -> " " ++ remove 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 -> " " ++ 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/Quote.hs b/src/VeriFuzz/Verilog/Quote.hs deleted file mode 100644 index 3815fe6..0000000 --- a/src/VeriFuzz/Verilog/Quote.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Quote -Description : QuasiQuotation for verilog code in Haskell. -Copyright : (c) 2019, Yann Herklotz Grave -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -QuasiQuotation for verilog code in Haskell. --} - -{-# LANGUAGE TemplateHaskell #-} - -module VeriSmith.Verilog.Quote - ( verilog - ) -where - -import Data.Data -import qualified Data.Text as T -import qualified Language.Haskell.TH as TH -import Language.Haskell.TH.Quote -import Language.Haskell.TH.Syntax -import VeriSmith.Verilog.Parser - -liftDataWithText :: Data a => a -> Q Exp -liftDataWithText = dataToExpQ $ fmap liftText . cast - -liftText :: T.Text -> Q Exp -liftText txt = AppE (VarE 'T.pack) <$> lift (T.unpack txt) - --- | Quasiquoter for verilog, so that verilog can be written inline and be --- parsed to an AST at compile time. -verilog :: QuasiQuoter -verilog = QuasiQuoter - { quoteExp = quoteVerilog - , quotePat = undefined - , quoteType = undefined - , quoteDec = undefined - } - -quoteVerilog :: String -> TH.Q TH.Exp -quoteVerilog s = do - loc <- TH.location - let pos = T.pack $ TH.loc_filename loc - v <- case parseVerilog pos (T.pack s) of - Right e -> return e - Left e -> fail $ show e - liftDataWithText v diff --git a/src/VeriFuzz/Verilog/Token.hs b/src/VeriFuzz/Verilog/Token.hs deleted file mode 100644 index 590672e..0000000 --- a/src/VeriFuzz/Verilog/Token.hs +++ /dev/null @@ -1,350 +0,0 @@ -{-| -Module : VeriSmith.Verilog.Token -Description : Tokens for Verilog parsing. -Copyright : (c) 2019, Yann Herklotz Grave -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Tokens for Verilog parsing. --} - -module VeriSmith.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