{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Verilog( VArg(..), VCaseArm(..), VDPI(..), VDPIType(..), VDType(..), VEventExpr(..), VExpr(..), VFunction(..), VId(..), VLValue(..), VMItem(..), VModule(..), VOp(..), VProgram(..), VRange, VStmt(..), VTri(..), VVDecl(..), VVar(..), VComment, vvName, vargName, commonDeclTypes, getVeriInsts, vGetMainModName, vKeywords, vSeq, vVDecl, vGroup, vGroupWithComment, mkVId, idToVId, vidToId, getVIdString, mkVEOp, mkVEUnOp, mkEqualsReset, mkNotEqualsReset, mkEdgeReset, mkReset, mkNotReset, defaultVId, vIsValidIdent -- vVar ) where #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 804) import Prelude hiding ((<>)) #endif import Data.List(nub) import Data.Maybe(fromMaybe) import Eval import PPrint import Fixity(Fixity(..)) import IntegerUtil(integerFormat, aaaa) import Util(itos, to_quoted_string) import ErrorUtil(internalError) import Id import Position import FStringCompat import Data.Char(isDigit, isAlpha) import qualified Data.Generics as Generic --import Debug.Trace -- string to start synthesis attributes with synthesis_str :: String synthesis_str = "synopsys" -- other possibilities --synthesis_str = "synthesis" --synthesis_str = "pragma" mkSynthPragma :: String -> Doc mkSynthPragma s = text ("// " ++ synthesis_str ++ " " ++ s) -- VProgram -- * a list of modules -- * a list of import-DPI declarations -- * a comment for the entire file, not for any one module data VProgram = VProgram [VModule] [VDPI] VComment deriving (Eq, Show, Generic.Data, Generic.Typeable) instance Hyper VProgram where hyper x y = (x==x) `seq` y instance PPrint VProgram where pPrint d p (VProgram ms dpis cs) = ppComment cs $+$ assignment_delay_macro $+$ reset_level_macro $+$ dpi_decls $+$ vsepEmptyLine (map (pPrint d 0) ms) $+$ text "" where -- define BSV_ASSIGNMENT_DELAY when the user does not override it assignment_delay_macro = text "" $+$ text "`ifdef BSV_ASSIGNMENT_DELAY" $+$ text "`else" $+$ text " `define BSV_ASSIGNMENT_DELAY" $+$ text "`endif" $+$ text "" reset_level_macro = text "`ifdef BSV_POSITIVE_RESET" $+$ text " `define BSV_RESET_VALUE 1'b1" $+$ text " `define BSV_RESET_EDGE posedge" $+$ text "`else" $+$ text " `define BSV_RESET_VALUE 1'b0" $+$ text " `define BSV_RESET_EDGE negedge" $+$ text "`endif" $+$ text "" dpi_decls = vsep (map (pPrint d 0) dpis) $+$ if (not (null dpis)) then text "" else empty -- VComment -- * a list of single-line comments (already broken into lines) -- XXX perhaps they can be less pre-formatted and pprint can -- XXX handle wrapping them? type VComment = [String] -- return "empty" if there is no comment, which is the unit of $+$, -- so there is no extra line in the output when there are no comments ppComment :: [String] -> Doc ppComment cs = let ppline str = text ("// " ++ str) in foldr ($+$) empty (map ppline cs) -- VDPI -- * The function name -- * The return type -- * The arguments (name, whether it's an input, type) data VDPI = VDPI VId VDPIType [(VId, Bool, VDPIType)] deriving (Eq, Show, Generic.Data, Generic.Typeable) instance PPrint VDPI where pPrint d p (VDPI name ret args) = let mkDir False = text "output" mkDir True = text "input" ppArg (i, dir, t) = mkDir dir <+> pPrint d 0 t <+> pPrint d 0 i in text "import \"DPI-C\" function" <+> pPrint d 0 ret <+> pPrint d 0 name <+> text "(" <> sepList (map ppArg args) (text ",") <> text ");" data VDPIType = VDT_void | VDT_byte | VDT_int | VDT_longint | VDT_wide Integer | VDT_string | VDT_poly deriving (Eq, Show, Generic.Data, Generic.Typeable) instance PPrint VDPIType where pPrint _ _ VDT_void = text "void" pPrint _ _ VDT_byte = text "byte unsigned" pPrint _ _ VDT_int = text "int unsigned" pPrint _ _ VDT_longint = text "longint unsigned" pPrint _ _ (VDT_wide n) = text $ "bit [" ++ itos (n-1) ++ ":0]" pPrint _ _ VDT_string = text "string" pPrint _ _ VDT_poly = text "bit []" -- VModule: -- * the module name -- * a list of single-line comments (already broken into lines) -- * the ports of the module (possibly grouped and commented) -- * the internals of the module data VModule = VModule { vm_name :: VId, vm_comments :: VComment, vm_ports :: [([VArg],VComment)] , vm_body :: [VMItem] } deriving (Eq, Show, Generic.Data, Generic.Typeable) instance PPrint VModule where pPrint d p vmodule = let -- don't include parameters in the port list isParam (VAParameter {}) = True isParam _ = False removeParams = filter (not . isParam) comments = ppComment (vm_comments vmodule) -- ports = vm_ports vmodule portlist = if null ports then text "" else pparen True $ commaSepEmptyLine (map ppPortListGroup ports) -- print the comma separated list of port names ppPortListGroup :: ([VArg],VComment) -> Doc ppPortListGroup ([],_) = empty ppPortListGroup (ps,_) = -- don't print the comment, -- no comma at the end of group (added when combining groups) vcatList (map (ppVArgPort d) (removeParams ps)) (text ",") -- print the declarations (e.g. "input x;") ppPortDeclGroup (ps, comment) = let port_decls = ppLinesBy ppVArgDecl d ps in ppComment comment $+$ port_decls modheader = text "module" <+> pPrint d p (vm_name vmodule) <> portlist <> text ";" modbody = -- I/O decls and VMItems are indented by two spaces, -- and the VMItems have spaces around some items for -- readability let gs = groupVMItems (vm_body vmodule) ppgroups g = text " " <> ppLines d g in text " " <> vsepEmptyLine (map ppPortDeclGroup ports) $+$ text "" $+$ -- empty line vsepEmptyLine (map ppgroups gs) modtail = text "endmodule //" <+> pPrint d 0 (vm_name vmodule) in comments $+$ modheader $+$ modbody $+$ modtail data VArg = VAInput VId (Maybe VRange) -- If the type is Nothing, then do not print a declaration | VAInout VId (Maybe VId) (Maybe (Maybe VRange)) | VAOutput VId (Maybe VRange) | VAParameter VId (Maybe VRange) VExpr deriving (Eq, Show, Generic.Data, Generic.Typeable) -- only use this for debugging instance PPrint VArg where pPrint d p (VAInput i mr) = text "VAInput" <+> pPrint d 0 i <+> ppMRange d mr pPrint d p (VAInout i Nothing mmr) = text "VAInout" <+> pPrint d 0 i <+> (case mmr of { Just mr -> ppMRange d mr; Nothing -> empty }) pPrint d p (VAInout i (Just i') mmr) = text "VAInout" <+> pPrint d 0 i <+> text "(" <> pPrint d 0 i' <> text ")" <+> (case mmr of { Just mr -> ppMRange d mr; Nothing -> empty }) pPrint d p (VAOutput i mr) = text "VAOutput" <+> pPrint d 0 i <+> ppMRange d mr pPrint d p (VAParameter i mr e) = text "VAParameter" <+> pPrint d 0 i <+> ppMRange d mr <+> pPrint d 0 e ppVArgPort :: PDetail -> VArg -> Doc ppVArgPort d (VAInput i _) = pPrint d 0 i ppVArgPort d (VAInout i Nothing _) = pPrint d 0 i ppVArgPort d (VAInout i (Just i') _) = text "." <> pPrint d 0 i <> text "(" <> pPrint d 0 i' <> text ")" ppVArgPort d (VAOutput i _) = pPrint d 0 i ppVArgPort d (VAParameter {}) = empty ppVArgDecl :: PDetail -> VArg -> Doc ppVArgDecl d (VAInput vi mr) = pPrint d 0 (VVDecl VDInput mr [VVar vi]) ppVArgDecl d (VAInout vi mvi' (Just mr)) = let i = fromMaybe vi mvi' in pPrint d 0 (VVDecl VDInout mr [VVar i]) ppVArgDecl d (VAInout vi mvi' Nothing) = empty ppVArgDecl d (VAOutput vi mr) = pPrint d 0 (VVDecl VDOutput mr [VVar vi]) ppVArgDecl d (VAParameter i mr e) = text "parameter" <+> ppMRange d mr <+> pPrint d 0 i <+> text "=" <+> pPrint d 0 e <> text ";" vargName :: VArg -> VId vargName (VAInput i _) = i vargName (VAInout i _ _) = i vargName (VAOutput i _) = i vargName (VAParameter i _ _) = i data VMItem = VMDecl VVDecl -- VMInst: vmi_instance_params and vmi_instance_ports can be positional -- or named, thus the Either (Left = a list of expressions, -- by position, and Right = list of (name, expression) pairs) | VMInst { vi_module_name :: VId, vi_inst_name :: VId, -- The string is for comments vi_inst_params :: Either [(Maybe String,VExpr)] [(VId, Maybe VExpr)], vi_inst_ports :: [(VId, Maybe VExpr)] } | VMAssign VLValue VExpr | VMStmt { vi_translate_off :: Bool, vi_body :: VStmt } | VMComment VComment VMItem -- like VMComment but specific to inlined registers, -- to carry info for xref generation. -- XXX could this not have been handled in mkRegGroup? | VMRegGroup VId String VComment VMItem -- VMGroup: the lists of VMItem will be separated by empty lines; -- if no spaces needed, use a list of one list. | VMGroup { vg_translate_off :: Bool, vg_body :: [[VMItem]]} | VMFunction VFunction deriving (Eq, Show, Generic.Data, Generic.Typeable) instance Ord VMItem where -- comments are just attached to other statements, -- and should not be used for ordering compare (VMComment _ x) (VMComment _ y) = compare x y compare (VMComment _ x) y = compare x y compare x (VMComment _ y) = compare x y compare (VMRegGroup _ _ _ x) (VMRegGroup _ _ _ y) = compare x y compare (VMRegGroup _ _ _ x) y = compare x y compare x (VMRegGroup _ _ _ y) = compare x y compare (VMDecl dl) (VMDecl dr) = compare dl dr compare (VMDecl _) _ = LT compare (VMInst _ _ _ _) (VMDecl _ ) = GT compare (VMInst _ _ _ _) (VMInst _ _ _ _) = EQ compare (VMInst _ _ _ _) _ = LT compare (VMAssign vl _) (VMAssign vr _) = compare vl vr compare (VMAssign _ _) (VMDecl _) = GT compare (VMAssign _ _) (VMInst _ _ _ _) = GT compare (VMAssign _ _) _ = LT compare (VMStmt {}) (VMDecl _) = GT compare (VMStmt {}) (VMInst _ _ _ _) = GT compare (VMStmt {}) (VMAssign _ _) = GT compare (VMStmt {}) (VMStmt {}) = EQ compare (VMStmt {}) _ = LT compare (VMFunction _) (VMFunction _) = EQ compare (VMFunction _) _ = GT compare (VMGroup _ _) (VMGroup _ _) = EQ compare (VMGroup _ _) _ = GT instance PPrint VMItem where pPrint d p (VMDecl dcl) = pPrint d p dcl pPrint d p s@(VMStmt {}) | vi_translate_off s = mkSynthPragma "translate_off" $$ pPrint d p (vi_body s) $$ mkSynthPragma "translate_on" | otherwise = pPrint d p (vi_body s) pPrint d p (VMAssign v e) = -- trace("Assignment :" ++ (ppReadable v) ++ " = " ++ (ppReadable e) ++ "\n") $ sep [text "assign" <+> pPrint d 45 v <+> text "=", nest 11 (pPrint d 0 e <+> text ";")] pPrint d p (VMInst mid iid pvs cs) = pPrint d 0 mid <> (case pvs of Left ps -> (if null ps then text "" else text " #" <> pparen True (sepList (map (pv95params d) ps) comma )) Right ps -> (if null ps then text "" else text " #" <> pparen True (sepList (map (\ (i, me) -> text "." <> pPrint d 0 i <> pparen True (case me of Just e -> pPrint d 0 e; Nothing -> text "")) ps) (text ",")))) <> text "" <+> pPrint d 0 iid <> pparen True (sepList (map (\ (i, me) -> text "." <> pPrint d 0 i <> pparen True (case me of Just e -> pPrint d 0 e; Nothing -> text "")) cs) (text ",")) <> text ";" pPrint d p (VMComment cs stmt) = ppComment cs $+$ pPrint d p stmt pPrint d p g@(VMGroup _ stmtss) | vg_translate_off g = mkSynthPragma "translate_off" $$ vsepEmptyLine (map (ppLines d) stmtss) $$ mkSynthPragma "translate_on" | otherwise = vsepEmptyLine (map (ppLines d) stmtss) pPrint d p (VMFunction f) = pPrint d p f pPrint d p (VMRegGroup inst_id def_name cs stmt) = text "// register" <+> pPrint d 0 inst_id $+$ ppComment cs $+$ pPrint d p stmt pv95params :: PDetail -> (Maybe String, VExpr) -> Doc pv95params d (Nothing,x) = pPrint d 0 x pv95params d (Just "", x) = pPrint d 0 x pv95params d (Just s,x) = text (" /*" ++ s ++ "*/ ") <> pPrint d 0 x -- Decide where to place blank spaces between VMItems, by grouping -- them into a list of lists between which there should be a space. -- A space is added around instantiations and statements (initial and -- always blocks). groupVMItems :: [VMItem] -> [[VMItem]] groupVMItems vmis = let -- identify which VMItems need a space before and after them needsSpace (VMInst _ _ _ _) = True needsSpace (VMStmt _ _) = True needsSpace (VMFunction _) = True needsSpace (VMGroup _ _) = True needsSpace (VMComment _ vmi) = needsSpace vmi needsSpace (VMRegGroup _ _ _ vmi) = needsSpace vmi needsSpace _ = False groupNeedsSpace [v] = needsSpace v groupNeedsSpace _ = False foldFunc v [] = [[v]] foldFunc v (g:gs) = if (needsSpace v || groupNeedsSpace g) then ([v]:g:gs) else ((v:g):gs) in foldr foldFunc [] vmis -- Convenience function to wrap a list of items in a VMGroup. -- If the list is empty, return an empty list (don't create a group of nothing) -- The boolean is whether to add spacing around items in the group vGroup :: Bool -> [VMItem] -> [VMItem] vGroup _ [] = [] -- preserve the group, as it implies spacing around the item(s) --vGroup _ [vmi] = [vmi] vGroup False vmis = [VMGroup False [vmis]] vGroup True vmis = [VMGroup False (groupVMItems vmis)] -- Convenience function to wrap a list of items in a VMComment of VMGroup. -- If the list is empty, return an empty list (don't create a group of nothing) -- The boolean is whether to add spacing around items in the group vGroupWithComment :: Bool -> [VMItem] -> VComment -> [VMItem] vGroupWithComment _ [] _ = [] vGroupWithComment False vmis comment = [VMComment comment (VMGroup False [vmis])] -- Put a blank line not only between lists, but also between the comment and -- the first list. To do this, comment an empty group. vGroupWithComment True vmis comment = let comment_group = [VMComment comment (VMGroup False [])] vmi_groups = groupVMItems vmis in [VMGroup False (comment_group : vmi_groups)] data VFunction = VFunction VId (Maybe VRange) [VFDecl] VStmt deriving (Eq, Show, Generic.Data, Generic.Typeable) type VFDecl = VVDecl -- not quite right instance PPrint VFunction where pPrint d p (VFunction name range decls stmt) = (text "function" <+> ppR d range <> pPrint d 0 name <> text ";") $+$ (text " " <> (ppLines d decls)) $+$ (text " " <> pPrint d 0 stmt) $+$ text "endfunction" where ppR _ Nothing = text "" ppR d (Just (h,l)) = ppRange d h l <+> text "" data VStmt = VAt VEventExpr VStmt | Valways VStmt | Vinitial VStmt | VSeq [VStmt] | Vcasex { vs_case_expr :: VExpr, vs_case_arms :: [VCaseArm], vs_parallel :: Bool, vs_full :: Bool } -- appears unused | Vcase { vs_case_expr :: VExpr, vs_case_arms :: [VCaseArm], vs_parallel :: Bool, vs_full :: Bool } | VAssign VLValue VExpr | VAssignA VLValue VExpr | Vif VExpr VStmt | Vifelse VExpr VStmt VStmt | Vdumpvars Int [VId] -- appears unused | VTask VId [VExpr] -- calling a verilog system task as a Bluespec foreign function of type Action | VAssert VEventExpr [VExpr] | VZeroDelay -- injecting an explicit (0-tick) delay for synchronization purposes deriving (Eq, Show, Generic.Data, Generic.Typeable) instance PPrint VStmt where pPrint d p (VAt e s) = sep [text "@" <> pparen True (pPrint d 0 e), pPrint d 0 s] pPrint d p (Valways (VAt e s)) = sep [text "always@" <> pparen True (pPrint d 0 e), pPrint d 0 s] pPrint d p (Valways s) = sep [text "always", pPrint d 0 s] pPrint d p (Vinitial s) = text "`ifdef BSV_NO_INITIAL_BLOCKS" $$ text "`else // not BSV_NO_INITIAL_BLOCKS" $$ sep [text "initial", pPrint d 0 s] $$ text "`endif // BSV_NO_INITIAL_BLOCKS" pPrint d p (VSeq ss) = text "begin" $+$ (text " " <> ppLines d ss) $+$ text "end" pPrint d p s@(Vcasex {}) = (text "casex" <+> pparen True (pPrint d 0 (vs_case_expr s))) <+> pprintCaseAttributes (vs_parallel s) (vs_full s) $+$ (text " " <> ppLines d (vs_case_arms s)) $+$ (text "endcase") pPrint d p s@(Vcase {}) = (text "case" <+> pparen True (pPrint d 0 (vs_case_expr s))) <+> pprintCaseAttributes (vs_parallel s) (vs_full s) $+$ (text " " <> ppLines d (vs_case_arms s)) $+$ (text "endcase") pPrint d p (VAssign v e) = -- if the expr doesn't fit on the same line, indent it 4 spaces sep [ pPrint d 0 v <+> text "=", nest 4 (pPrint d 0 e <> text ";") ] pPrint d p (VAssignA v e) = -- if the expr doesn't fit on the same line, indent it 4 spaces sep [ pPrint d 0 v <+> text "<=" <+> text "`BSV_ASSIGNMENT_DELAY", nest 4 (pPrint d 0 e <> text ";") ] pPrint d p (Vif e s) | isOne e = pPrint d p s -- optimize ifs that are always true pPrint d p (Vif e s) | isZero e = text "" -- optimize away ifs that are always false pPrint d p (Vif e s) = -- if it doesn't fit on one line, start on the next (indent 2) sep [text "if (" <> pPrint d 0 e <> text ")", nest 2 (pPrint d 0 s)] pPrint d p (Vifelse e s1 s2) = -- for readability, don't allow if-else to fit on one line -- (thus, use "vcat" instead of "sep") vcat [text "if (" <> pPrint d 0 e <> text ")", nest 2 (pPrint d 0 s1), text "else", nest 2 (pPrint d 0 s2)] pPrint d p (Vdumpvars level vars) = text "$dumpvars(" <> sepList dvargs (text ",") <> text ");" where dvargs = (pPrint d 0 level):(map (pPrint d 0) vars) -- no parens when calling a task if it has no arguments pPrint d p (VTask task []) | isTaskVId task = pPrint d 0 task <> text ";" pPrint d p (VTask task es) = pPrint d 0 task <> text "(" <> commaList d es <> text ");" pPrint d p (VAssert ev es) = ppAssert d p ev es pPrint d p VZeroDelay = text "#0;" ppAssert :: PDetail -> Int -> VEventExpr -> [VExpr] -> Doc --ppAssert d i ev (VEString s : es) = text (pretty 78 78 (ppAs1 d i s es)) ppAssert d i ev (VEString s1 : VEString s2 : es) = text (s1++": assert property (@(") <> pPrint d 0 ev <> text ")" $$ ppAs1 d i s2 es ppAssert _ _ _ es = internalError ("ppAssert: " ++ show es) ppAs1 :: PDetail -> Int -> String -> [VExpr] -> Doc ppAs1 d i s [] = internalError("ppAs1D: " ++ s) ppAs1 d i "" [b] = text s where v0 = ppReadable b v = take ((length v0) -1) v0 s = ") "++v++"=1; else "++v++"=0;" ppAs1 d i "" es = internalError("ppAs1A: " ++ show es) ppAs1 d i ('%':'b':s) (x:xs) = pPrint d i x $$ ppAs1 d i s xs ppAs1 d i ('%':'n':s) (x:xs) = pPrint d i x $$ ppAs1 d i s xs ppAs1 d i ss@('%':s) (x:xs) = internalError("ppAs1B: " ++ show ss) ppAs1 d i cs xs = text c1 <> ppAs1 d i c2 xs where c1 = takeWhile (/='%') cs c2 = dropWhile (/='%') cs pprintCaseAttributes :: Bool -> Bool -> Doc pprintCaseAttributes False False = empty pprintCaseAttributes True False = mkSynthPragma "parallel_case" pprintCaseAttributes False True = mkSynthPragma "full_case" pprintCaseAttributes True True = mkSynthPragma "parallel_case full_case" -- hack to check if expressions are known to be true or false isOne :: VExpr -> Bool isOne (VEConst 1) = True isOne (VEWConst _ _ _ 1) = True isOne e = False isZero :: VExpr -> Bool isZero (VEConst 0) = True isZero (VEWConst _ _ _ 0) = True isZero e = False data VLValue = VLId VId | VLConcat [VLValue] | VLSub VLValue VExpr deriving (Eq, Show, Generic.Data, Generic.Typeable) instance Ord VLValue where compare (VLId lid) (VLId rid) = compare lid rid compare (VLSub vvl _) (VLSub vvr _) = compare vvl vvr compare _ _ = EQ instance PPrint VLValue where pPrint d p (VLId i) = pPrint d p i pPrint d p (VLConcat vs) = text "{ " <> commaList d vs <> text " }" pPrint d p (VLSub i e) = pPrint d 100 i <> text "[" <> pPrint d 0 e <> text "]" data VCaseArm = VCaseArm [VExpr] VStmt | VDefault VStmt deriving (Eq, Show, Generic.Data, Generic.Typeable) instance PPrint VCaseArm where pPrint d p (VCaseArm es s) = -- nest the statement 4 spaces under the expr list -- when it doesn't fit on the same line sep [ sepList (map (pPrint d 0) es) (text ",") <> text ":", nest 4 (pPrint d 0 s) ] pPrint d p (VDefault s) = text "default:" <+> pPrint d 0 s -- Always add begin end blocks -- more consistent with a "good" Verilog style vSeq :: [VStmt] -> VStmt -- vSeq [s] = s vSeq ss = VSeq ss data VVDecl = VVDecl VDType (Maybe VRange) [VVar] | VVDWire (Maybe VRange) VVar VExpr deriving (Eq, Show, Generic.Data, Generic.Typeable) instance Ord VVDecl where compare (VVDecl _ _ _) (VVDWire _ _ _) = LT compare (VVDWire _ _ _) (VVDecl _ _ _) = GT compare (VVDecl tl mrl vvl) (VVDecl tr mrr vvr)= compare (tl,mrr,vvl) (tr,mrl,vvr) -- vars with range are first, the mmr mrl swap is not a typo compare (VVDWire mrl vl _) (VVDWire mrr vr _) = compare vl vr instance PPrint VVDecl where pPrint d p (VVDecl t (Just (h, l)) is) = pPrint d p t <+> ppRange d h l <+> commaList d is <> text ";" pPrint d p (VVDecl t Nothing is) = pPrint d p t <+> commaList d is <> text ";" pPrint d p (VVDWire (Just (h, l)) i e) = sep [text "wire" <+> ppRange d h l <+> pPrint d 0 i <+> text "=", nest 4 (pPrint d 0 e <> text ";")] pPrint d p (VVDWire Nothing i e) = sep [text "wire" <+> pPrint d 0 i <+> text "=", nest 4 (pPrint d 0 e <> text ";")] -- A short cut constructor vVDecl :: VDType -> Maybe VRange -> VVar -> VVDecl vVDecl t r v = VVDecl t r [v] data VDType = VDReg | VDWire | VDInput | VDInout | VDOutput -- only for decls deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable, Enum) instance PPrint VDType where pPrint d p VDReg = text "reg" pPrint d p VDWire = text "wire" pPrint d p VDInput = text "input " pPrint d p VDInout = text "inout " pPrint d p VDOutput = text "output" data VVar = VVar VId | VArray VRange VId deriving (Eq, Show, Generic.Data, Generic.Typeable) instance Ord VVar where compare (VVar lid) (VArray _ rid) = compare lid rid compare (VArray _ lid) (VVar rid) = compare lid rid compare (VVar lid) (VVar rid) = compare lid rid compare (VArray lr lid) (VArray rr rid) = compare lid rid instance PPrint VVar where pPrint d p (VVar i) = pPrint d p i pPrint d p (VArray (l, h) i) = pPrint d p i <> ppRange d l h vvName :: VVar -> VId vvName (VVar i) = i vvName (VArray _ i) = i -- the VMItem is used for inlined registers data VId = VId String Id (Maybe VMItem) deriving (Show, Generic.Data, Generic.Typeable) instance Ord VId where compare (VId s1 _ _) (VId s2 _ _) = compare s1 s2 instance Eq VId where VId string _ _ == VId string' _ _ = (string == string') mkVId :: String -> VId mkVId string = VId string (mkId noPosition (mkFString string)) Nothing idToVId :: Id -> VId idToVId id = (VId (getIdString id) id Nothing) vidToId :: VId -> Id vidToId (VId _ i _) = i getVIdString :: VId -> String getVIdString (VId s _ _) = s instance PPrint VId where pPrint d p (VId s i _) = text s instance HasPosition VId where getPosition (VId _ inside_id _) = getPosition inside_id -- whether a VId is syntactically a task ID isTaskVId :: VId -> Bool isTaskVId (VId ('$':_) _ _) = True isTaskVId _ = False type VRange = (VExpr, VExpr) data VEventExpr = VEEOr VEventExpr VEventExpr | VEEposedge VExpr | VEEnegedge VExpr | VEE VExpr | VEEMacro String VExpr deriving (Eq, Show, Generic.Data, Generic.Typeable) instance PPrint VEventExpr where pPrint d p (VEEOr e1 e2) = -- if the second expr doesn't fit on the same line, -- put it on the next line sep [pPrint d 10 e1 <+> text "or", pPrint d 10 e2] pPrint d p (VEEposedge e) = text "posedge" <+> pPrint d 10 e pPrint d p (VEEnegedge e) = text "negedge" <+> pPrint d 10 e pPrint d p (VEE e) = pPrint d p e pPrint d p (VEEMacro s e) = text ("`" ++ s) <+> pPrint d (p+1) e data VExpr = VEConst Integer | VEReal Double | VEWConst VId Integer Integer Integer -- width base value (what is VId?) | VEUnknown Integer String | VEString String | VETriConst [VTri] | VEUnOp VId VOp VExpr | VEOp VId VExpr VOp VExpr | VEVar VId | VEConcat [VExpr] | VEIndex VId VExpr | VESelect VExpr VExpr VExpr | VESelect1 VExpr VExpr | VERepeat VExpr VExpr | VEIf VExpr VExpr VExpr | VEFctCall VId [VExpr] | VEMacro String deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable) -- vVar :: String -> VExpr -- vVar = VEVar . VId instance PPrint VExpr where pPrint d p (VEConst i) = text (itos i) pPrint d p (VEReal r) = text (show r) pPrint d p v@(VEWConst _ w b i) = text (createVEWConstString w b i) -- pPrint d p (VEUnknown w) = text (itos w ++"'b0/*x*/") pPrint d p (VEUnknown w val) = pPrint d p v <> text " /* unspecified value */ " where wint = fromInteger w v = case val of "A" -> (VEWConst (mkVId (itos (aaaa w))) w 2 (aaaa w)) "0" -> (VEWConst (mkVId (itos (0::Integer))) w 2 (0)) "1" -> VETriConst (replicate wint V1) "X" -> VETriConst (replicate wint Vx) "Z" -> VETriConst (replicate wint Vz) _ -> internalError( "Verilog::pPrint: " ++ ppReadable val) pPrint d p (VEString s) = text $ to_quoted_string s pPrint d p (VEMacro s) = text ("`" ++ s) pPrint d p (VETriConst ts) = text (itos (length ts) ++ "'b") <> foldr (<>) (text "") (map (pPrint d 0) ts) pPrint d p (VEUnOp _ op e) = pparen (p>11) (pPrint d 0 op <> pPrint d 100 e) pPrint d p (VEOp vid e1 op e2) = ppOp d p vid e1 op e2 pPrint d p (VEVar i) = pPrint d p i pPrint d p (VEConcat es) = text "{ " <> commaList d es <> text " }" pPrint d p (VEIndex i e) = pPrint d 100 i <> text "[" <> pPrint d 0 e <> text "]" pPrint d p (VESelect e h l) = pPrint d 100 e <> text "[" <> pPrint d 0 h <> text ":" <> pPrint d 0 l <> text "]" pPrint d p (VESelect1 e pos) = pPrint d 100 e <> text "[" <> pPrint d 0 pos <> text "]" pPrint d p (VERepeat e1 e2) | isZero e1 = internalError ("Verilog.pPrint - bad VERepeat: " ++ ppReadable (e1, e2)) pPrint d p (VERepeat e1 e2) = text "{" <> pPrint d 100 e1 <> text "{" <> pPrint d 0 e2 <> text "}}" -- possibly redundant but the Vif analog helps optimize foreign function calls pPrint d p (VEIf e1 e2 e3) | isOne e1 = pPrint d p e2 -- optimize conditional expressions known to be true pPrint d p (VEIf e1 e2 e3) | isZero e1 = pPrint d p e3 -- optimize conditional expressions known to be false pPrint d p (VEIf e1 e2 e3) = pparen (p > 0) $ sep [ pPrint d 100 e1 <+> text "?", nest 2 (pPrint d 1 e2 <+> text ":"), nest 2 (pPrint d 1 e3) ] pPrint d p (VEFctCall f []) | isTaskVId f = pPrint d 0 f pPrint d p (VEFctCall f es) = pPrint d 0 f <> text "(" <> commaList d es <> text ")" createVEWConstString :: Integer -> Integer -> Integer -> String createVEWConstString width base 0 = (itos width ++ "'" ++ baseChar base ++ "0") where baseChar :: Integer -> String baseChar 2 = "b" baseChar 8 = "o" baseChar 10 = "d" baseChar 16 = "h" baseChar _ = "b" createVEWConstString width base value = (itos width ++ "'" ++ baseChar base' ++ integerFormat width' base' value) where baseChar :: Integer -> String baseChar 2 = "b" baseChar 8 = "o" baseChar 10 = "d" baseChar 16 = "h" baseChar b = internalError ("baseChar: unexpected pattern: " ++ show b) whichBase :: Integer -> Integer -> Integer whichBase 0 i = whichBase 16 i whichBase _ i | i > 2000000000 = 16 whichBase b _ = fromInteger b whichWidth 2 w = w whichWidth 8 w = (w+2) `div` 3 whichWidth 10 w = 0 whichWidth 16 w = (w+3) `div` 4 whichWidth w _ = internalError ("whichWidth: unexpected pattern: " ++ show w ) base' = whichBase base value width' = whichWidth base' width data VTri = V0 | V1 | Vx | Vz deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable, Enum) instance PPrint VTri where pPrint d p V0 = text "0" pPrint d p V1 = text "1" pPrint d p Vx = text "x" pPrint d p Vz = text "z" data VOp = VNot -- logical not ! | VInv -- bit wise inverse | VNeg | VMul | VQuot | VRem | VAdd | VSub | VShL | VShR | VShLA | VShRA | VULT | VULE | VUGT | VUGE | VEQ | VNE | VEQ3 | VNE3 | VAnd -- bitwise Operations | VXor | VOr | VLAnd -- logical AND and OR | VLOr deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable, Enum) instance PPrint VOp where pPrint d p op = text (getOpString op) getOpString :: VOp -> String getOpString VNot = "!" getOpString VInv = "~" getOpString VNeg = "-" getOpString VMul = "*" getOpString VQuot = "/" getOpString VRem = "%" getOpString VAdd = "+" getOpString VSub = "-" getOpString VShL = "<<" getOpString VShR = ">>" getOpString VShRA = ">>>" getOpString VShLA = "<<<" getOpString VULT = "<" getOpString VULE = "<=" getOpString VUGE = ">=" getOpString VUGT = ">" getOpString VEQ = "==" getOpString VNE = "!=" getOpString VEQ3 = "===" getOpString VNE3 = "!==" getOpString VAnd = "&" getOpString VXor = "^" getOpString VOr = "|" getOpString VLAnd = "&&" getOpString VLOr = "||" getOpFixity :: VOp -> Fixity getOpFixity op = case op of VNot -> FInfix 15 VInv -> FInfix 15 VNeg -> FInfix 13 VMul -> FInfixl 11 VQuot -> FInfixl 11 VRem -> FInfixl 11 VAdd -> FInfixa 10 VSub -> FInfixl 10 VShL -> FInfix 9 VShR -> FInfix 9 VShLA -> FInfix 9 VShRA -> FInfix 9 VULT -> FInfix 8 VULE -> FInfix 8 VUGE -> FInfix 8 VUGT -> FInfix 8 VEQ -> FInfix 7 VNE -> FInfix 7 VEQ3 -> FInfix 7 VNE3 -> FInfix 7 VAnd -> FInfixa 6 VXor -> FInfixa 5 VOr -> FInfixa 4 VLAnd-> FInfixa 3 VLOr -> FInfixa 2 -- _ -> internalError ("getOpFixity " ++ show op) -- Only keep assoc for for Sub. Keep VAdd out of this list, since DC can -- do a better job with optimization without parens Bug 302 keepAssoc :: VOp -> Bool keepAssoc op = op `elem` [VSub{-, VAdd, VAnd, VOr, VXor-}] vGetMainModName :: VProgram -> String vGetMainModName (VProgram program_items _ _) = let get_mod_name (headmod:_) = getVIdString $ vm_name headmod get_mod_name [] = internalError "vGetMainModName: no main module" in get_mod_name program_items vKeywords :: [String] vKeywords = [ "or", "rtran", "nor", "assign", "realtime", "tran", "not", "endcase", "endtable", "endmodule", "table", "endfunction", "endprimitive", "for", "nand", "force", "forever", "deassign", "event", "repeat", "end", "output", "posedge", "function", "parameter", "endspecify", "default", "and", "case", "casez", "specify", "wor", "strong0", "rtranif0", "else", "release", "notif0", "tranif0", "buf", "real", "large", "negedge", "scalered", "wand", "strong1", "rtranif1", "begin", "notif1", "tranif1", "edge", "trior", "integer", "vectored", "join", "rnmos", "inout", "bufif0", "supply0", "xor", "xnor", "weak0", "nmos", "disable", "task", "triand", "pulldown", "if", "always", "endtask", "primitive", "input", "bufif1", "supply1", "fork", "weak1", "rpmos", "module", "wire", "while", "specparam", "pmos", "rcmos", "reg", "tri0", "defparam", "pullup", "wait", "casex", "cmos", "macromodule", "tri1", "pull0", "trireg", "small", "tri", "signed", "pull1", "time", "highz0", "localparam", "medium", "highz1", "initial" ] vIsValidIdent :: String -> Bool vIsValidIdent "" = False vIsValidIdent (c:cs) = (isLetterOrUnderscore c) && all isLetterDigitUnderscoreOrDollar cs where isLetterOrUnderscore x = (isAlpha x) || (x == '_') isLetterDigitUnderscoreOrDollar x = (isAlpha x) || (isDigit x) || (x == '_') || (x == '$') ------- ppLines :: PPrint a => PDetail -> [a] -> Doc ppLines d xs = foldr ($+$) empty (map (pPrint d 0) xs) ppLinesBy :: (a -> b -> Doc) -> a -> [b] -> Doc ppLinesBy f d xs = foldr ($+$) empty (map (f d) xs) vsepEmptyLine :: [Doc] -> Doc vsepEmptyLine [] = empty vsepEmptyLine xs = foldr1 (\x y -> x $+$ text "" $+$ y) xs commaList :: PPrint a => PDetail -> [a] -> Doc commaList d xs = sepList (map (pPrint d 0) xs) (text ",") {- -- commaList uses sep, which can put things on one line vcatCommaList :: PPrint a => PDetail -> [a] -> Doc vcatCommaList d xs = vcatList (map (pPrint d 0) xs) (text ",") -} -- both of the above functions at once commaSepEmptyLine :: [Doc] -> Doc commaSepEmptyLine [] = empty commaSepEmptyLine xs = foldr1 (nextLine) xs where nextLine :: Doc -> Doc -> Doc nextLine x y | (x == empty) && (y == empty) = empty | (x == empty) = y | (y == empty) = x | otherwise = x <> text "," $+$ text "" $+$ y ppRange :: PDetail -> VExpr -> VExpr -> Doc ppRange d a b = text "[" <> pPrint d 0 a <+> text ":" <+> pPrint d 0 b <> text "]" ppMRange :: PDetail -> Maybe VRange -> Doc ppMRange _ Nothing = empty ppMRange d (Just (h,l)) = ppRange d h l ppOp :: PDetail -> Int -> VId -> VExpr -> VOp -> VExpr -> Doc ppOp d pd vid@(VId string id _) p1 op p2 = let (p, lp, rp) = case getOpFixity op of FInfixl p -> (p, p, p+1) FInfixr p -> (p, p+1, p) FInfix p -> (p, p+1, p+1) FInfixa p -> (p, p, p) FPrefix -> (p, p, p ) in pparen (d > PDReadable || pd>p || pd==p && keepAssoc op) (sep [pPrint d lp p1 <> text"" <+> pPrint d 0 op, pPrint d rp p2]) ------- getVeriInsts :: VProgram -> [String] getVeriInsts (VProgram ms _ _) = nub (concatMap getInstsFromVModule ms) where getInstsFromVModule vmod = concatMap getInstsFromVMItem (vm_body vmod) -- extract module names from instances in VMItem getInstsFromVMItem (VMInst { vi_module_name = vid }) = [getVIdString vid] getInstsFromVMItem (VMComment _ i) = getInstsFromVMItem i getInstsFromVMItem (VMRegGroup _ _ _ i) = getInstsFromVMItem i getInstsFromVMItem (VMGroup _ iss) = concatMap (concatMap getInstsFromVMItem) iss getInstsFromVMItem _ = [] -- true if the declarions have the same type commonDeclTypes :: VVDecl -> VVDecl -> Bool commonDeclTypes (VVDecl t1 r1 _ ) (VVDecl t2 r2 _ ) = (t1,r1) == (t2,r2) commonDeclTypes _ _ = False -- ############################################################################# -- # -- ############################################################################# mkVEOp :: VExpr -> VOp -> VExpr -> VExpr mkVEOp vexpr_0 vop vexpr_1 = VEOp defaultVId vexpr_0 vop vexpr_1 mkVEUnOp :: VOp -> VExpr -> VExpr mkVEUnOp vop vexpr = VEUnOp defaultVId vop vexpr defaultVId :: VId defaultVId = mkVId "Default" -- ############################################################################# -- # -- ############################################################################# mkEqualsReset :: VExpr -> VExpr mkEqualsReset e = mkVEOp e VEQ mkReset mkNotEqualsReset :: VExpr -> VExpr mkNotEqualsReset e = mkVEOp e VNE mkReset mkEdgeReset :: VExpr -> VEventExpr mkEdgeReset e = VEEMacro "BSV_RESET_EDGE" e mkReset :: VExpr mkReset = VEMacro "BSV_RESET_VALUE" mkNotReset :: VExpr mkNotReset = mkVEUnOp VNot mkReset