diff options
Diffstat (limited to 'src/VeriSmith/Verilog')
| -rw-r--r-- | src/VeriSmith/Verilog/AST.hs | 583 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/BitVec.hs | 119 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/CodeGen.hs | 341 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Eval.hs | 119 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Internal.hs | 93 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Lex.x | 188 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Mutate.hs | 401 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Parser.hs | 511 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Preprocess.hs | 111 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Quote.hs | 50 | ||||
| -rw-r--r-- | src/VeriSmith/Verilog/Token.hs | 350 |
11 files changed, 2866 insertions, 0 deletions
diff --git a/src/VeriSmith/Verilog/AST.hs b/src/VeriSmith/Verilog/AST.hs new file mode 100644 index 0000000..78bad45 --- /dev/null +++ b/src/VeriSmith/Verilog/AST.hs @@ -0,0 +1,583 @@ +{-| +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/VeriSmith/Verilog/BitVec.hs b/src/VeriSmith/Verilog/BitVec.hs new file mode 100644 index 0000000..dab9e2c --- /dev/null +++ b/src/VeriSmith/Verilog/BitVec.hs @@ -0,0 +1,119 @@ +{-| +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/VeriSmith/Verilog/CodeGen.hs b/src/VeriSmith/Verilog/CodeGen.hs new file mode 100644 index 0000000..1e94472 --- /dev/null +++ b/src/VeriSmith/Verilog/CodeGen.hs @@ -0,0 +1,341 @@ +{-| +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/VeriSmith/Verilog/Eval.hs b/src/VeriSmith/Verilog/Eval.hs new file mode 100644 index 0000000..1ebaa80 --- /dev/null +++ b/src/VeriSmith/Verilog/Eval.hs @@ -0,0 +1,119 @@ +{-| +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/VeriSmith/Verilog/Internal.hs b/src/VeriSmith/Verilog/Internal.hs new file mode 100644 index 0000000..ed91b12 --- /dev/null +++ b/src/VeriSmith/Verilog/Internal.hs @@ -0,0 +1,93 @@ +{-| +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/VeriSmith/Verilog/Lex.x b/src/VeriSmith/Verilog/Lex.x new file mode 100644 index 0000000..3d1dd8d --- /dev/null +++ b/src/VeriSmith/Verilog/Lex.x @@ -0,0 +1,188 @@ +-- -*- 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/VeriSmith/Verilog/Mutate.hs b/src/VeriSmith/Verilog/Mutate.hs new file mode 100644 index 0000000..58675e3 --- /dev/null +++ b/src/VeriSmith/Verilog/Mutate.hs @@ -0,0 +1,401 @@ +{-| +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 +-- <BLANKLINE> +-- <BLANKLINE> +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); +-- <BLANKLINE> +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)); +-- <BLANKLINE> +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 +-- <BLANKLINE> +-- <BLANKLINE> +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/VeriSmith/Verilog/Parser.hs b/src/VeriSmith/Verilog/Parser.hs new file mode 100644 index 0000000..8d2b729 --- /dev/null +++ b/src/VeriSmith/Verilog/Parser.hs @@ -0,0 +1,511 @@ +{-| +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/VeriSmith/Verilog/Preprocess.hs b/src/VeriSmith/Verilog/Preprocess.hs new file mode 100644 index 0000000..c30252b --- /dev/null +++ b/src/VeriSmith/Verilog/Preprocess.hs @@ -0,0 +1,111 @@ +{-| +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/VeriSmith/Verilog/Quote.hs b/src/VeriSmith/Verilog/Quote.hs new file mode 100644 index 0000000..3815fe6 --- /dev/null +++ b/src/VeriSmith/Verilog/Quote.hs @@ -0,0 +1,50 @@ +{-| +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/VeriSmith/Verilog/Token.hs b/src/VeriSmith/Verilog/Token.hs new file mode 100644 index 0000000..590672e --- /dev/null +++ b/src/VeriSmith/Verilog/Token.hs @@ -0,0 +1,350 @@ +{-| +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) |