Commit cecd141e by Zachary Snow

revamped support system with most SystemVerilog types and signed types

parent 45d16a30
...@@ -25,14 +25,14 @@ convert :: AST -> AST ...@@ -25,14 +25,14 @@ convert :: AST -> AST
convert = traverseDescriptions convertDescription convert = traverseDescriptions convertDescription
defaultType :: Type defaultType :: Type
defaultType = Logic [(Number "31", Number "0")] defaultType = IntegerVector TLogic Unspecified [(Number "31", Number "0")]
convertDescription :: Description -> Description convertDescription :: Description -> Description
convertDescription (description @ (Part _ _ _ _)) = convertDescription (description @ (Part _ _ _ _)) =
Part kw name ports (enumItems ++ items) Part kw name ports (enumItems ++ items)
where where
enumPairs = concat $ map (uncurry enumVals) $ Set.toList enums enumPairs = concat $ map (uncurry enumVals) $ Set.toList enums
enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit []) x v) enumPairs enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit Unspecified []) x v) enumPairs
(Part kw name ports items, enums) = (Part kw name ports items, enums) =
runWriter $ traverseModuleItemsM (traverseTypesM traverseType) $ runWriter $ traverseModuleItemsM (traverseTypesM traverseType) $
traverseModuleItems (traverseExprs $ traverseNestedExprs traverseExpr) $ traverseModuleItems (traverseExprs $ traverseNestedExprs traverseExpr) $
......
...@@ -17,7 +17,7 @@ convertFunction (MIPackageItem (Function ml t f decls stmts)) = ...@@ -17,7 +17,7 @@ convertFunction (MIPackageItem (Function ml t f decls stmts)) =
MIPackageItem $ Function ml t' f decls stmts MIPackageItem $ Function ml t' f decls stmts
where where
t' = case t of t' = case t of
Reg rs -> Implicit rs IntegerVector TReg sg rs -> Implicit sg rs
Logic rs -> Implicit rs IntegerVector TLogic sg rs -> Implicit sg rs
_ -> t _ -> t
convertFunction other = other convertFunction other = other
...@@ -30,14 +30,17 @@ convertDescription (orig @ (Part Module _ _ _)) = ...@@ -30,14 +30,17 @@ convertDescription (orig @ (Part Module _ _ _)) =
where where
idents = execWriter (collectModuleItemsM regIdents orig) idents = execWriter (collectModuleItemsM regIdents orig)
convertModuleItem :: ModuleItem -> ModuleItem convertModuleItem :: ModuleItem -> ModuleItem
convertModuleItem (MIDecl (Variable dir (Logic mr) ident a me)) = convertModuleItem (MIDecl (Variable dir (IntegerVector TLogic sg mr) ident a me)) =
MIDecl $ Variable dir (t mr) ident a me MIDecl $ Variable dir (t mr) ident a me
where t = if Set.member ident idents then Reg else Wire where
t = if sg /= Unspecified || Set.member ident idents
then IntegerVector TReg sg
else Net TWire
convertModuleItem other = other convertModuleItem other = other
-- all other logics (i.e. inside of functions) become regs -- all other logics (i.e. inside of functions) become regs
convertDecl :: Decl -> Decl convertDecl :: Decl -> Decl
convertDecl (Variable d (Logic rs) x a me) = convertDecl (Variable d (IntegerVector TLogic sg rs) x a me) =
Variable d (Reg rs) x a me Variable d (IntegerVector TReg sg rs) x a me
convertDecl other = other convertDecl other = other
convertDescription other = other convertDescription other = other
......
...@@ -158,7 +158,7 @@ unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) = ...@@ -158,7 +158,7 @@ unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) =
[ GenModuleItem $ MIPackageItem $ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr [ GenModuleItem $ MIPackageItem $ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr
, GenModuleItem $ MIDecl $ Variable Local t arrUnflat [(majorHi, majorLo)] Nothing , GenModuleItem $ MIDecl $ Variable Local t arrUnflat [(majorHi, majorLo)] Nothing
, GenModuleItem $ Genvar index , GenModuleItem $ Genvar index
, GenModuleItem $ MIDecl $ Variable Local IntegerT (arrUnflat ++ "_repeater_index") [] Nothing , GenModuleItem $ MIDecl $ Variable Local (IntegerAtom TInteger Unspecified) (arrUnflat ++ "_repeater_index") [] Nothing
, GenFor , GenFor
(index, majorLo) (index, majorLo)
(BinOp Le (Ident index) majorHi) (BinOp Le (Ident index) majorHi)
...@@ -180,13 +180,13 @@ unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) = ...@@ -180,13 +180,13 @@ unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) =
(minorHi, minorLo) = head $ snd $ typeRanges t (minorHi, minorLo) = head $ snd $ typeRanges t
size = rangeSize (minorHi, minorLo) size = rangeSize (minorHi, minorLo)
localparam :: Identifier -> Expr -> GenItem localparam :: Identifier -> Expr -> GenItem
localparam x v = GenModuleItem $ MIDecl $ Localparam (Implicit []) x v localparam x v = GenModuleItem $ MIDecl $ Localparam (Implicit Unspecified []) x v
origRange = ( (BinOp Add (Ident startBit) origRange = ( (BinOp Add (Ident startBit)
(BinOp Sub size (Number "1"))) (BinOp Sub size (Number "1")))
, Ident startBit ) , Ident startBit )
typeIsImplicit :: Type -> Bool typeIsImplicit :: Type -> Bool
typeIsImplicit (Implicit _) = True typeIsImplicit (Implicit _ _) = True
typeIsImplicit _ = False typeIsImplicit _ = False
-- prefix a string with a namespace of sorts -- prefix a string with a namespace of sorts
......
...@@ -40,10 +40,12 @@ convertDescription description = ...@@ -40,10 +40,12 @@ convertDescription description =
-- write down unstructured versions of a packed struct type -- write down unstructured versions of a packed struct type
collectType :: Type -> Writer Structs () collectType :: Type -> Writer Structs ()
collectType (Struct True fields _) = do collectType (Struct (Packed sg) fields _) = do
-- TODO: How should we combine the structs Signing with that of the types it
-- contains?
if canUnstructure if canUnstructure
then tell $ Map.singleton then tell $ Map.singleton
(Struct True fields) (Struct (Packed sg) fields)
(unstructType, unstructFields) (unstructType, unstructFields)
else return () else return ()
where where
...@@ -98,7 +100,7 @@ convertType structs t1 = ...@@ -98,7 +100,7 @@ convertType structs t1 =
-- write down the type a declarations -- write down the type a declarations
collectDecl :: Decl -> Writer Types () collectDecl :: Decl -> Writer Types ()
collectDecl (Variable _ (Implicit []) _ _ _) = return () collectDecl (Variable _ (Implicit _ []) _ _ _) = return ()
collectDecl (Variable _ t x a _) = collectDecl (Variable _ t x a _) =
-- We add the unpacked dimensions to the type so that our type traversal can -- We add the unpacked dimensions to the type so that our type traversal can
-- correctly match-off the dimensions whenever we see a `Bit` or `Range` -- correctly match-off the dimensions whenever we see a `Bit` or `Range`
...@@ -125,18 +127,18 @@ convertAsgn structs types (lhs, expr) = ...@@ -125,18 +127,18 @@ convertAsgn structs types (lhs, expr) =
convertLHS :: LHS -> (Type, LHS) convertLHS :: LHS -> (Type, LHS)
convertLHS (LHSIdent x) = convertLHS (LHSIdent x) =
case Map.lookup x types of case Map.lookup x types of
Nothing -> (Implicit [], LHSIdent x) Nothing -> (Implicit Unspecified [], LHSIdent x)
Just t -> (t, LHSIdent x) Just t -> (t, LHSIdent x)
convertLHS (LHSBit l e) = convertLHS (LHSBit l e) =
if null rs if null rs
then (Implicit [], LHSBit l' e) then (Implicit Unspecified [], LHSBit l' e)
else (tf $ tail rs, LHSBit l' e) else (tf $ tail rs, LHSBit l' e)
where where
(t, l') = convertLHS l (t, l') = convertLHS l
(tf, rs) = typeRanges t (tf, rs) = typeRanges t
convertLHS (LHSRange l r ) = convertLHS (LHSRange l r ) =
if null rs if null rs
then (Implicit [], LHSRange l' r) then (Implicit Unspecified [], LHSRange l' r)
else (tf rs', LHSRange l' r) else (tf rs', LHSRange l' r)
where where
(t, l') = convertLHS l (t, l') = convertLHS l
...@@ -144,7 +146,7 @@ convertAsgn structs types (lhs, expr) = ...@@ -144,7 +146,7 @@ convertAsgn structs types (lhs, expr) =
rs' = r : tail rs rs' = r : tail rs
convertLHS (LHSDot l x ) = convertLHS (LHSDot l x ) =
case t of case t of
InterfaceT _ _ _ -> (Implicit [], LHSDot l' x) InterfaceT _ _ _ -> (Implicit Unspecified [], LHSDot l' x)
Struct _ _ _ -> case Map.lookup structTf structs of Struct _ _ _ -> case Map.lookup structTf structs of
Nothing -> (fieldType, LHSDot l' x) Nothing -> (fieldType, LHSDot l' x)
Just (structT, m) -> (tf [tr], LHSRange l' r) Just (structT, m) -> (tf [tr], LHSRange l' r)
...@@ -154,7 +156,7 @@ convertAsgn structs types (lhs, expr) = ...@@ -154,7 +156,7 @@ convertAsgn structs types (lhs, expr) =
hi' = BinOp Add base $ BinOp Sub hi lo hi' = BinOp Add base $ BinOp Sub hi lo
lo' = base lo' = base
tr = (simplify hi', simplify lo') tr = (simplify hi', simplify lo')
Implicit _ -> (Implicit [], LHSDot l' x) Implicit sg _ -> (Implicit sg [], LHSDot l' x)
_ -> error $ "convertLHS encountered dot for bad type: " ++ show (t, l, x) _ -> error $ "convertLHS encountered dot for bad type: " ++ show (t, l, x)
where where
(t, l') = convertLHS l (t, l') = convertLHS l
...@@ -162,18 +164,18 @@ convertAsgn structs types (lhs, expr) = ...@@ -162,18 +164,18 @@ convertAsgn structs types (lhs, expr) =
structTf = Struct p fields structTf = Struct p fields
fieldType = lookupFieldType fields x fieldType = lookupFieldType fields x
convertLHS (LHSConcat lhss) = convertLHS (LHSConcat lhss) =
(Implicit [], LHSConcat $ map (snd . convertLHS) lhss) (Implicit Unspecified [], LHSConcat $ map (snd . convertLHS) lhss)
-- try expression conversion by looking at the *outermost* type first -- try expression conversion by looking at the *outermost* type first
convertExpr :: Type -> Expr -> Expr convertExpr :: Type -> Expr -> Expr
convertExpr (Struct True fields []) (Pattern items) = convertExpr (Struct (Packed sg) fields []) (Pattern items) =
if Map.notMember structTf structs if Map.notMember structTf structs
then Pattern items'' then Pattern items''
else Concat exprs else Concat exprs
where where
subMap = \(Just ident, subExpr) -> subMap = \(Just ident, subExpr) ->
(Just ident, convertExpr (lookupFieldType fields ident) subExpr) (Just ident, convertExpr (lookupFieldType fields ident) subExpr)
structTf = Struct True fields structTf = Struct (Packed sg) fields
items' = items' =
-- if the pattern does not use identifiers, use the -- if the pattern does not use identifiers, use the
-- identifiers from the struct type definition in order -- identifiers from the struct type definition in order
...@@ -189,7 +191,7 @@ convertAsgn structs types (lhs, expr) = ...@@ -189,7 +191,7 @@ convertAsgn structs types (lhs, expr) =
convertSubExpr :: Expr -> (Type, Expr) convertSubExpr :: Expr -> (Type, Expr)
convertSubExpr (Ident x) = convertSubExpr (Ident x) =
case Map.lookup x types of case Map.lookup x types of
Nothing -> (Implicit [], Ident x) Nothing -> (Implicit Unspecified [], Ident x)
Just t -> (t, Ident x) Just t -> (t, Ident x)
convertSubExpr (Access e x) = convertSubExpr (Access e x) =
case subExprType of case subExprType of
...@@ -197,7 +199,7 @@ convertAsgn structs types (lhs, expr) = ...@@ -197,7 +199,7 @@ convertAsgn structs types (lhs, expr) =
if Map.notMember structTf structs if Map.notMember structTf structs
then (fieldType, Access e' x) then (fieldType, Access e' x)
else (fieldType, Range e' r) else (fieldType, Range e' r)
_ -> (Implicit [], Access e' x) _ -> (Implicit Unspecified [], Access e' x)
where where
(subExprType, e') = convertSubExpr e (subExprType, e') = convertSubExpr e
Struct p fields [] = subExprType Struct p fields [] = subExprType
...@@ -217,16 +219,16 @@ convertAsgn structs types (lhs, expr) = ...@@ -217,16 +219,16 @@ convertAsgn structs types (lhs, expr) =
_ -> (t, Range eOuter' rOuter) _ -> (t, Range eOuter' rOuter)
where (t, eOuter') = convertSubExpr eOuter where (t, eOuter') = convertSubExpr eOuter
convertSubExpr (Concat exprs) = convertSubExpr (Concat exprs) =
(Implicit [], Concat $ map (snd . convertSubExpr) exprs) (Implicit Unspecified [], Concat $ map (snd . convertSubExpr) exprs)
convertSubExpr (BinOp op e1 e2) = convertSubExpr (BinOp op e1 e2) =
(Implicit [], BinOp op e1' e2') (Implicit Unspecified [], BinOp op e1' e2')
where where
(_, e1') = convertSubExpr e1 (_, e1') = convertSubExpr e1
(_, e2') = convertSubExpr e2 (_, e2') = convertSubExpr e2
-- TODO: There are other expression cases that we probably need to -- TODO: There are other expression cases that we probably need to
-- recurse into. That said, it's not clear to me how much we really -- recurse into. That said, it's not clear to me how much we really
-- expect to see things like concatenated packed structs, for example. -- expect to see things like concatenated packed structs, for example.
convertSubExpr other = (Implicit [], other) convertSubExpr other = (Implicit Unspecified [], other)
-- lookup the range of a field in its unstructured type -- lookup the range of a field in its unstructured type
lookupUnstructRange :: TypeFunc -> Identifier -> Range lookupUnstructRange :: TypeFunc -> Identifier -> Range
......
...@@ -412,12 +412,12 @@ traverseTypesM mapper item = ...@@ -412,12 +412,12 @@ traverseTypesM mapper item =
traverseExprsM (traverseNestedExprsM exprMapper) traverseExprsM (traverseNestedExprsM exprMapper)
where where
fullMapper t = tm t >>= mapper fullMapper t = tm t >>= mapper
tm (Reg r) = return $ Reg r tm (Alias xx rs) = return $ Alias xx rs
tm (Wire r) = return $ Wire r tm (Net kw rs) = return $ Net kw rs
tm (Logic r) = return $ Logic r tm (Implicit sg rs) = return $ Implicit sg rs
tm (Alias x r) = return $ Alias x r tm (IntegerVector kw sg rs) = return $ IntegerVector kw sg rs
tm (Implicit r) = return $ Implicit r tm (IntegerAtom kw sg ) = return $ IntegerAtom kw sg
tm (IntegerT ) = return $ IntegerT tm (NonInteger kw ) = return $ NonInteger kw
tm (InterfaceT x my r) = return $ InterfaceT x my r tm (InterfaceT x my r) = return $ InterfaceT x my r
tm (Enum Nothing vals r) = tm (Enum Nothing vals r) =
return $ Enum Nothing vals r return $ Enum Nothing vals r
......
...@@ -49,11 +49,11 @@ convertDescription globalTypes description = ...@@ -49,11 +49,11 @@ convertDescription globalTypes description =
removeTypedef other = other removeTypedef other = other
resolveType :: Types -> Type -> Type resolveType :: Types -> Type -> Type
resolveType _ (Reg rs) = Reg rs resolveType _ (Net kw rs) = Net kw rs
resolveType _ (Wire rs) = Wire rs resolveType _ (Implicit sg rs) = Implicit sg rs
resolveType _ (Logic rs) = Logic rs resolveType _ (IntegerVector kw sg rs) = IntegerVector kw sg rs
resolveType _ (Implicit rs) = Implicit rs resolveType _ (IntegerAtom kw sg ) = IntegerAtom kw sg
resolveType _ (IntegerT ) = IntegerT resolveType _ (NonInteger kw ) = NonInteger kw
resolveType _ (InterfaceT x my rs) = InterfaceT x my rs resolveType _ (InterfaceT x my rs) = InterfaceT x my rs
resolveType _ (Enum Nothing vals rs) = Enum Nothing vals rs resolveType _ (Enum Nothing vals rs) = Enum Nothing vals rs
resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs
...@@ -65,12 +65,12 @@ resolveType types (Alias st rs1) = ...@@ -65,12 +65,12 @@ resolveType types (Alias st rs1) =
if Map.notMember st types if Map.notMember st types
then InterfaceT st Nothing rs1 then InterfaceT st Nothing rs1
else case resolveType types $ types Map.! st of else case resolveType types $ types Map.! st of
(Reg rs2) -> Reg $ rs2 ++ rs1 (Net kw rs2) -> Net kw $ rs2 ++ rs1
(Wire rs2) -> Wire $ rs2 ++ rs1 (Implicit sg rs2) -> Implicit sg $ rs2 ++ rs1
(Logic rs2) -> Logic $ rs2 ++ rs1 (IntegerVector kw sg rs2) -> IntegerVector kw sg $ rs2 ++ rs1
(Enum t v rs2) -> Enum t v $ rs2 ++ rs1 (Enum t v rs2) -> Enum t v $ rs2 ++ rs1
(Struct p l rs2) -> Struct p l $ rs2 ++ rs1 (Struct p l rs2) -> Struct p l $ rs2 ++ rs1
(InterfaceT x my rs2) -> InterfaceT x my $ rs2 ++ rs1 (InterfaceT x my rs2) -> InterfaceT x my $ rs2 ++ rs1
(Implicit rs2) -> Implicit $ rs2 ++ rs1 (IntegerAtom kw _ ) -> error $ "resolveType encountered packed `" ++ (show kw) ++ "` on " ++ st
(IntegerT ) -> error $ "resolveType encountered packed `integer` on " ++ st (NonInteger kw ) -> error $ "resolveType encountered packed `" ++ (show kw) ++ "` on " ++ st
(Alias _ _) -> error $ "resolveType invariant failed on " ++ st (Alias _ _) -> error $ "resolveType invariant failed on " ++ st
...@@ -31,6 +31,12 @@ module Language.SystemVerilog.AST ...@@ -31,6 +31,12 @@ module Language.SystemVerilog.AST
, typeRanges , typeRanges
, simplify , simplify
, rangeSize , rangeSize
, Signing (..)
, NetType (..)
, IntegerVectorType (..)
, IntegerAtomType (..)
, NonIntegerType (..)
, Packing (..)
) where ) where
import Data.List import Data.List
...@@ -113,25 +119,109 @@ instance Show Direction where ...@@ -113,25 +119,109 @@ instance Show Direction where
show Inout = "inout" show Inout = "inout"
show Local = "" show Local = ""
data Signing
= Unspecified
| Signed
| Unsigned
deriving (Eq, Ord)
instance Show Signing where
show Unspecified = ""
show Signed = "signed"
show Unsigned = "unsigned"
data NetType
= TSupply0
| TSupply1
| TTri
| TTriand
| TTrior
| TTrireg
| TTri0
| TTri1
| TUwire
| TWire
| TWand
| TWor
deriving (Eq, Ord)
data IntegerVectorType
= TBit
| TLogic
| TReg
deriving (Eq, Ord)
data IntegerAtomType
= TByte
| TShortint
| TInt
| TLongint
| TInteger
| TTime
deriving (Eq, Ord)
data NonIntegerType
= TShortreal
| TReal
| TRealtime
deriving (Eq, Ord)
instance Show NetType where
show TSupply0 = "supply0"
show TSupply1 = "supply1"
show TTri = "tri"
show TTriand = "triand"
show TTrior = "trior"
show TTrireg = "trireg"
show TTri0 = "tri0"
show TTri1 = "tri1"
show TUwire = "uwire"
show TWire = "wire"
show TWand = "wand"
show TWor = "wor"
instance Show IntegerVectorType where
show TBit = "bit"
show TLogic = "logic"
show TReg = "reg"
instance Show IntegerAtomType where
show TByte = "byte"
show TShortint = "shortint"
show TInt = "int"
show TLongint = "longint"
show TInteger = "integer"
show TTime = "time"
instance Show NonIntegerType where
show TShortreal = "shortreal"
show TReal = "real"
show TRealtime = "realtime"
data Packing
= Unpacked
| Packed Signing
deriving (Eq, Ord)
instance Show Packing where
show (Unpacked) = ""
show (Packed s) = "packed" ++ (showPadBefore s)
type Item = (Identifier, Maybe Expr)
type Field = (Type, Identifier)
data Type data Type
= Reg [Range] = IntegerVector IntegerVectorType Signing [Range]
| Wire [Range] | IntegerAtom IntegerAtomType Signing
| Logic [Range] | NonInteger NonIntegerType
| Net NetType [Range]
| Implicit Signing [Range]
| Alias Identifier [Range] | Alias Identifier [Range]
| Implicit [Range] | Enum (Maybe Type) [Item] [Range]
| IntegerT | Struct Packing [Field] [Range]
| Enum (Maybe Type) [(Identifier, Maybe Expr)] [Range]
| Struct Bool [(Type, Identifier)] [Range]
| InterfaceT Identifier (Maybe Identifier) [Range] | InterfaceT Identifier (Maybe Identifier) [Range]
deriving (Eq, Ord) deriving (Eq, Ord)
instance Show Type where instance Show Type where
show (Reg r) = "reg" ++ (showRanges r) show (Alias xx rs) = printf "%s%s" xx (showRanges rs)
show (Wire r) = "wire" ++ (showRanges r) show (Net kw rs) = printf "%s%s" (show kw) (showRanges rs)
show (Logic r) = "logic" ++ (showRanges r) show (Implicit sg rs) = printf "%s%s" (show sg) (showRanges rs)
show (Alias t r) = t ++ (showRanges r) show (IntegerVector kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs)
show (Implicit r) = (showRanges r) show (IntegerAtom kw sg ) = printf "%s%s" (show kw) (showPadBefore sg)
show (IntegerT ) = "integer" show (NonInteger kw ) = printf "%s" (show kw)
show (InterfaceT x my r) = x ++ yStr ++ (showRanges r) show (InterfaceT x my r) = x ++ yStr ++ (showRanges r)
where yStr = maybe "" ("."++) my where yStr = maybe "" ("."++) my
show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r) show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
...@@ -139,28 +229,32 @@ instance Show Type where ...@@ -139,28 +229,32 @@ instance Show Type where
tStr = maybe "" showPad mt tStr = maybe "" showPad mt
showVal :: (Identifier, Maybe Expr) -> String showVal :: (Identifier, Maybe Expr) -> String
showVal (x, e) = x ++ (showAssignment e) showVal (x, e) = x ++ (showAssignment e)
show (Struct p items r) = printf "struct %s{\n%s\n}%s" packedStr itemsStr (showRanges r) show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) itemsStr (showRanges r)
where where
packedStr = if p then "packed " else ""
itemsStr = indent $ unlines' $ map showItem items itemsStr = indent $ unlines' $ map showItem items
showItem (t, x) = printf "%s %s;" (show t) x showItem (t, x) = printf "%s %s;" (show t) x
instance Show ([Range] -> Type) where instance Show ([Range] -> Type) where
show tf = show (tf []) show tf = show (tf [])
instance Eq ([Range] -> Type) where instance Eq ([Range] -> Type) where
(==) tf1 tf2 = (tf1 []) == (tf2 []) (==) tf1 tf2 = (tf1 []) == (tf2 [])
instance Ord ([Range] -> Type) where instance Ord ([Range] -> Type) where
compare tf1 tf2 = compare (show tf1) (show tf2) compare tf1 tf2 = compare (tf1 []) (tf2 [])
instance Show (Signing -> [Range] -> Type) where
show tf = show (tf Unspecified)
instance Eq (Signing -> [Range] -> Type) where
(==) tf1 tf2 = (tf1 Unspecified) == (tf2 Unspecified)
instance Ord (Signing -> [Range] -> Type) where
compare tf1 tf2 = compare (tf1 Unspecified) (tf2 Unspecified)
typeRanges :: Type -> ([Range] -> Type, [Range]) typeRanges :: Type -> ([Range] -> Type, [Range])
typeRanges (Reg r) = (Reg , r) typeRanges (Alias xx rs) = (Alias xx , rs)
typeRanges (Wire r) = (Wire , r) typeRanges (Net kw rs) = (Net kw , rs)
typeRanges (Logic r) = (Logic , r) typeRanges (Implicit sg rs) = (Implicit sg, rs)
typeRanges (Alias t r) = (Alias t, r) typeRanges (IntegerVector kw sg rs) = (IntegerVector kw sg, rs)
typeRanges (Implicit r) = (Implicit, r) typeRanges (IntegerAtom kw sg ) = (\[] -> IntegerAtom kw sg, [])
typeRanges (IntegerT ) = (\[] -> IntegerT, []) typeRanges (NonInteger kw ) = (\[] -> NonInteger kw , [])
typeRanges (Enum t v r) = (Enum t v, r) typeRanges (Enum t v r) = (Enum t v, r)
typeRanges (Struct p l r) = (Struct p l, r) typeRanges (Struct p l r) = (Struct p l, r)
typeRanges (InterfaceT x my r) = (InterfaceT x my, r) typeRanges (InterfaceT x my r) = (InterfaceT x my, r)
...@@ -283,6 +377,13 @@ showPad x = ...@@ -283,6 +377,13 @@ showPad x =
else str ++ " " else str ++ " "
where str = show x where str = show x
showPadBefore :: Show t => t -> String
showPadBefore x =
if str == ""
then ""
else " " ++ str
where str = show x
indent :: String -> String indent :: String -> String
indent a = '\t' : f a indent a = '\t' : f a
where where
......
...@@ -16,10 +16,10 @@ $decimalDigit = [0-9] ...@@ -16,10 +16,10 @@ $decimalDigit = [0-9]
@octalDigit = @xDigit | @zDigit | [0-7] @octalDigit = @xDigit | @zDigit | [0-7]
@hexDigit = @xDigit | @zDigit | [0-9a-fA-F] @hexDigit = @xDigit | @zDigit | [0-9a-fA-F]
@decimalBase = "'" [dD] @decimalBase = "'" [sS]? [dD]
@binaryBase = "'" [bB] @binaryBase = "'" [sS]? [bB]
@octalBase = "'" [oO] @octalBase = "'" [sS]? [oO]
@hexBase = "'" [hH] @hexBase = "'" [sS]? [hH]
@binaryValue = @binaryDigit ("_" | @binaryDigit)* @binaryValue = @binaryDigit ("_" | @binaryDigit)*
@octalValue = @octalDigit ("_" | @octalDigit)* @octalValue = @octalDigit ("_" | @octalDigit)*
...@@ -80,7 +80,9 @@ tokens :- ...@@ -80,7 +80,9 @@ tokens :-
"assign" { tok KW_assign } "assign" { tok KW_assign }
"automatic" { tok KW_automatic } "automatic" { tok KW_automatic }
"begin" { tok KW_begin } "begin" { tok KW_begin }
"bit" { tok KW_bit }
"buf" { tok KW_buf } "buf" { tok KW_buf }
"byte" { tok KW_byte }
"case" { tok KW_case } "case" { tok KW_case }
"casex" { tok KW_casex } "casex" { tok KW_casex }
"casez" { tok KW_casez } "casez" { tok KW_casez }
...@@ -105,10 +107,12 @@ tokens :- ...@@ -105,10 +107,12 @@ tokens :-
"initial" { tok KW_initial } "initial" { tok KW_initial }
"inout" { tok KW_inout } "inout" { tok KW_inout }
"input" { tok KW_input } "input" { tok KW_input }
"int" { tok KW_int }
"integer" { tok KW_integer } "integer" { tok KW_integer }
"interface" { tok KW_interface } "interface" { tok KW_interface }
"localparam" { tok KW_localparam } "localparam" { tok KW_localparam }
"logic" { tok KW_logic } "logic" { tok KW_logic }
"longint" { tok KW_longint }
"modport" { tok KW_modport } "modport" { tok KW_modport }
"module" { tok KW_module } "module" { tok KW_module }
"nand" { tok KW_nand } "nand" { tok KW_nand }
...@@ -120,16 +124,34 @@ tokens :- ...@@ -120,16 +124,34 @@ tokens :-
"packed" { tok KW_packed } "packed" { tok KW_packed }
"parameter" { tok KW_parameter } "parameter" { tok KW_parameter }
"posedge" { tok KW_posedge } "posedge" { tok KW_posedge }
"real" { tok KW_real }
"realtime" { tok KW_realtime }
"reg" { tok KW_reg } "reg" { tok KW_reg }
"repeat" { tok KW_repeat } "repeat" { tok KW_repeat }
"return" { tok KW_return } "return" { tok KW_return }
"shortint" { tok KW_shortint }
"shortreal" { tok KW_shortreal }
"signed" { tok KW_signed }
"static" { tok KW_static } "static" { tok KW_static }
"struct" { tok KW_struct } "struct" { tok KW_struct }
"supply0" { tok KW_supply0 }
"supply1" { tok KW_supply1 }
"task" { tok KW_task } "task" { tok KW_task }
"time" { tok KW_time }
"tri" { tok KW_tri }
"tri0" { tok KW_tri0 }
"tri1" { tok KW_tri1 }
"triand" { tok KW_triand }
"trior" { tok KW_trior }
"trireg" { tok KW_trireg }
"typedef" { tok KW_typedef } "typedef" { tok KW_typedef }
"unique" { tok KW_unique } "unique" { tok KW_unique }
"unsigned" { tok KW_unsigned }
"uwire" { tok KW_uwire }
"wand" { tok KW_wand }
"while" { tok KW_while } "while" { tok KW_while }
"wire" { tok KW_wire } "wire" { tok KW_wire }
"wor" { tok KW_wor }
"xnor" { tok KW_xnor } "xnor" { tok KW_xnor }
"xor" { tok KW_xor } "xor" { tok KW_xor }
......
...@@ -25,7 +25,9 @@ import Language.SystemVerilog.Parser.Tokens ...@@ -25,7 +25,9 @@ import Language.SystemVerilog.Parser.Tokens
"assign" { Token KW_assign _ _ } "assign" { Token KW_assign _ _ }
"automatic" { Token KW_automatic _ _ } "automatic" { Token KW_automatic _ _ }
"begin" { Token KW_begin _ _ } "begin" { Token KW_begin _ _ }
"bit" { Token KW_bit _ _ }
"buf" { Token KW_buf _ _ } "buf" { Token KW_buf _ _ }
"byte" { Token KW_byte _ _ }
"case" { Token KW_case _ _ } "case" { Token KW_case _ _ }
"casex" { Token KW_casex _ _ } "casex" { Token KW_casex _ _ }
"casez" { Token KW_casez _ _ } "casez" { Token KW_casez _ _ }
...@@ -50,10 +52,12 @@ import Language.SystemVerilog.Parser.Tokens ...@@ -50,10 +52,12 @@ import Language.SystemVerilog.Parser.Tokens
"initial" { Token KW_initial _ _ } "initial" { Token KW_initial _ _ }
"inout" { Token KW_inout _ _ } "inout" { Token KW_inout _ _ }
"input" { Token KW_input _ _ } "input" { Token KW_input _ _ }
"int" { Token KW_int _ _ }
"integer" { Token KW_integer _ _ } "integer" { Token KW_integer _ _ }
"interface" { Token KW_interface _ _ } "interface" { Token KW_interface _ _ }
"localparam" { Token KW_localparam _ _ } "localparam" { Token KW_localparam _ _ }
"logic" { Token KW_logic _ _ } "logic" { Token KW_logic _ _ }
"longint" { Token KW_longint _ _ }
"modport" { Token KW_modport _ _ } "modport" { Token KW_modport _ _ }
"module" { Token KW_module _ _ } "module" { Token KW_module _ _ }
"nand" { Token KW_nand _ _ } "nand" { Token KW_nand _ _ }
...@@ -65,16 +69,34 @@ import Language.SystemVerilog.Parser.Tokens ...@@ -65,16 +69,34 @@ import Language.SystemVerilog.Parser.Tokens
"packed" { Token KW_packed _ _ } "packed" { Token KW_packed _ _ }
"parameter" { Token KW_parameter _ _ } "parameter" { Token KW_parameter _ _ }
"posedge" { Token KW_posedge _ _ } "posedge" { Token KW_posedge _ _ }
"real" { Token KW_real _ _ }
"realtime" { Token KW_realtime _ _ }
"reg" { Token KW_reg _ _ } "reg" { Token KW_reg _ _ }
"repeat" { Token KW_repeat _ _ } "repeat" { Token KW_repeat _ _ }
"return" { Token KW_return _ _ } "return" { Token KW_return _ _ }
"shortint" { Token KW_shortint _ _ }
"shortreal" { Token KW_shortreal _ _ }
"signed" { Token KW_signed _ _ }
"static" { Token KW_static _ _ } "static" { Token KW_static _ _ }
"struct" { Token KW_struct _ _ } "struct" { Token KW_struct _ _ }
"supply0" { Token KW_supply0 _ _ }
"supply1" { Token KW_supply1 _ _ }
"task" { Token KW_task _ _ } "task" { Token KW_task _ _ }
"time" { Token KW_time _ _ }
"tri" { Token KW_tri _ _ }
"tri0" { Token KW_tri0 _ _ }
"tri1" { Token KW_tri1 _ _ }
"triand" { Token KW_triand _ _ }
"trior" { Token KW_trior _ _ }
"trireg" { Token KW_trireg _ _ }
"typedef" { Token KW_typedef _ _ } "typedef" { Token KW_typedef _ _ }
"unique" { Token KW_unique _ _ } "unique" { Token KW_unique _ _ }
"unsigned" { Token KW_unsigned _ _ }
"uwire" { Token KW_uwire _ _ }
"wand" { Token KW_wand _ _ }
"while" { Token KW_while _ _ } "while" { Token KW_while _ _ }
"wire" { Token KW_wire _ _ } "wire" { Token KW_wire _ _ }
"wor" { Token KW_wor _ _ }
"xnor" { Token KW_xnor _ _ } "xnor" { Token KW_xnor _ _ }
"xor" { Token KW_xor _ _ } "xor" { Token KW_xor _ _ }
...@@ -209,15 +231,56 @@ Directive :: { String } ...@@ -209,15 +231,56 @@ Directive :: { String }
: directive { tokenString $1 } : directive { tokenString $1 }
Type :: { Type } Type :: { Type }
: PartialType Dimensions { $1 $2 } : PartialType Dimensions { $1 Unspecified $2 }
| PartialType Signing Dimensions { $1 $2 $3 }
| Identifier Dimensions { Alias $1 $2 } | Identifier Dimensions { Alias $1 $2 }
PartialType :: { [Range] -> Type } PartialType :: { Signing -> [Range] -> Type }
: "wire" { Wire } : NetType { \Unspecified -> Net $1 }
| "reg" { Reg } | IntegerVectorType { IntegerVector $1 }
| "logic" { Logic } | IntegerAtomType { \sg -> \[] -> IntegerAtom $1 sg }
| "enum" opt(Type) "{" EnumItems "}" { Enum $2 $4 } | NonIntegerType { \Unspecified -> \[] -> NonInteger $1 }
| "struct" Packed "{" StructItems "}" { Struct $2 $4 } | "enum" opt(Type) "{" EnumItems "}" { \Unspecified -> Enum $2 $4 }
| "integer" { \[] -> IntegerT } | "struct" Packing "{" StructItems "}" { \Unspecified -> Struct $2 $4 }
CastingType :: { Type }
: IntegerVectorType { IntegerVector $1 Unspecified [] }
| IntegerAtomType { IntegerAtom $1 Unspecified }
| NonIntegerType { NonInteger $1 }
| Signing { Implicit $1 [] }
Signing :: { Signing }
: "signed" { Signed }
| "unsigned" { Unsigned }
NetType :: { NetType }
: "supply0" { TSupply0 }
| "supply1" { TSupply1 }
| "tri" { TTri }
| "triand" { TTriand }
| "trior" { TTrior }
| "trireg" { TTrireg }
| "tri0" { TTri0 }
| "tri1" { TTri1 }
| "uwire" { TUwire }
| "wire" { TWire }
| "wand" { TWand }
| "wor" { TWor }
IntegerVectorType :: { IntegerVectorType }
: "bit" { TBit }
| "logic" { TLogic }
| "reg" { TReg }
IntegerAtomType :: { IntegerAtomType }
: "byte" { TByte }
| "shortint" { TShortint }
| "int" { TInt }
| "longint" { TLongint }
| "integer" { TInteger }
| "time" { TTime }
NonIntegerType :: { NonIntegerType }
: "shortreal" { TShortreal }
| "real" { TReal }
| "realtime" { TRealtime }
EnumItems :: { [(Identifier, Maybe Expr)] } EnumItems :: { [(Identifier, Maybe Expr)] }
: VariablePortIdentifiers { $1 } : VariablePortIdentifiers { $1 }
...@@ -228,9 +291,10 @@ StructItems :: { [(Type, Identifier)] } ...@@ -228,9 +291,10 @@ StructItems :: { [(Type, Identifier)] }
StructItem :: { (Type, Identifier) } StructItem :: { (Type, Identifier) }
: Type Identifier ";" { ($1, $2) } : Type Identifier ";" { ($1, $2) }
Packed :: { Bool } Packing :: { Packing }
: "packed" { True } : "packed" Signing { Packed $2 }
| {- empty -} { False } | "packed" { Packed Unspecified }
| {- empty -} { Unpacked }
Part :: { Description } Part :: { Description }
: "module" Identifier Params PortDecls ";" ModuleItems "endmodule" opt(Tag) { Part Module $2 (fst $4) ($3 ++ (snd $4) ++ $6) } : "module" Identifier Params PortDecls ";" ModuleItems "endmodule" opt(Tag) { Part Module $2 (fst $4) ($3 ++ (snd $4) ++ $6) }
...@@ -308,6 +372,7 @@ DeclOrStmtToken :: { DeclToken } ...@@ -308,6 +372,7 @@ DeclOrStmtToken :: { DeclToken }
| "{" LHSs "}" { DTConcat $2 } | "{" LHSs "}" { DTConcat $2 }
| PartialType { DTType $1 } | PartialType { DTType $1 }
| "." Identifier { DTDot $2 } | "." Identifier { DTDot $2 }
| Signing { DTSigning $1 }
VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] } VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
: VariablePortIdentifier { [$1] } : VariablePortIdentifier { [$1] }
...@@ -379,9 +444,11 @@ PackageItem :: { PackageItem } ...@@ -379,9 +444,11 @@ PackageItem :: { PackageItem }
| "task" opt(Lifetime) Identifier TFItems DeclsAndStmts "endtask" opt(Tag) { Task $2 $3 (map defaultFuncInput $ $4 ++ fst $5) (snd $5) } | "task" opt(Lifetime) Identifier TFItems DeclsAndStmts "endtask" opt(Tag) { Task $2 $3 (map defaultFuncInput $ $4 ++ fst $5) (snd $5) }
FuncRetAndName :: { (Type, Identifier) } FuncRetAndName :: { (Type, Identifier) }
: {- empty -} Identifier { (Implicit [], $1) } : Type Identifier { ($1 , $2) }
| DimensionsNonEmpty Identifier { (Implicit $1, $2) } | Identifier { (Implicit Unspecified [], $1) }
| Type Identifier { ($1 , $2) } | Signing Identifier { (Implicit $1 [], $2) }
| DimensionsNonEmpty Identifier { (Implicit Unspecified $1, $2) }
| Signing DimensionsNonEmpty Identifier { (Implicit $1 $2, $3) }
AlwaysKW :: { AlwaysKW } AlwaysKW :: { AlwaysKW }
: "always" { Always } : "always" { Always }
...@@ -401,8 +468,10 @@ TFItems :: { [Decl] } ...@@ -401,8 +468,10 @@ TFItems :: { [Decl] }
| ";" { [] } | ";" { [] }
ParamType :: { Type } ParamType :: { Type }
: Dimensions { Implicit $1 } : "integer" Signing { IntegerAtom TInteger $2 }
| "integer" { IntegerT } | "integer" { IntegerAtom TInteger Unspecified }
| Dimensions { Implicit Unspecified $1 }
| Signing Dimensions { Implicit $1 $2 }
Dimensions :: { [Range] } Dimensions :: { [Range] }
: {- empty -} { [] } : {- empty -} { [] }
...@@ -599,7 +668,7 @@ Expr :: { Expr } ...@@ -599,7 +668,7 @@ Expr :: { Expr }
| "^" Expr %prec RedOps { UniOp RedXor $2 } | "^" Expr %prec RedOps { UniOp RedXor $2 }
| "~^" Expr %prec RedOps { UniOp RedXnor $2 } | "~^" Expr %prec RedOps { UniOp RedXnor $2 }
| "^~" Expr %prec RedOps { UniOp RedXnor $2 } | "^~" Expr %prec RedOps { UniOp RedXnor $2 }
| PartialType "'" "(" Expr ")" { Cast ($1 []) $4 } | CastingType "'" "(" Expr ")" { Cast ($1 ) $4 }
| Identifier "'" "(" Expr ")" { Cast (Alias $1 []) $4 } | Identifier "'" "(" Expr ")" { Cast (Alias $1 []) $4 }
| Expr "." Identifier { Access $1 $3 } | Expr "." Identifier { Access $1 $3 }
| "'" "{" PatternItems "}" { Pattern $3 } | "'" "{" PatternItems "}" { Pattern $3 }
...@@ -689,8 +758,8 @@ makeInput (Variable _ t x a me) = Variable Input t x a me ...@@ -689,8 +758,8 @@ makeInput (Variable _ t x a me) = Variable Input t x a me
makeInput other = error $ "unexpected non-var decl: " ++ (show other) makeInput other = error $ "unexpected non-var decl: " ++ (show other)
defaultFuncInput :: Decl -> Decl defaultFuncInput :: Decl -> Decl
defaultFuncInput (Variable Input (Implicit rs) x a me) = defaultFuncInput (Variable Input (Implicit sg rs) x a me) =
Variable Input (Logic rs) x a me Variable Input (IntegerVector TLogic sg rs) x a me
defaultFuncInput other = other defaultFuncInput other = other
combineTags :: Maybe Identifier -> Maybe Identifier -> Maybe Identifier combineTags :: Maybe Identifier -> Maybe Identifier -> Maybe Identifier
......
...@@ -51,12 +51,13 @@ data DeclToken ...@@ -51,12 +51,13 @@ data DeclToken
| DTRange Range | DTRange Range
| DTIdent Identifier | DTIdent Identifier
| DTDir Direction | DTDir Direction
| DTType ([Range] -> Type) | DTType (Signing -> [Range] -> Type)
| DTParams [PortBinding] | DTParams [PortBinding]
| DTInstance (Identifier, [PortBinding]) | DTInstance (Identifier, [PortBinding])
| DTBit Expr | DTBit Expr
| DTConcat [LHS] | DTConcat [LHS]
| DTDot Identifier | DTDot Identifier
| DTSigning Signing
deriving (Show, Eq) deriving (Show, Eq)
...@@ -257,11 +258,13 @@ takeDir rest = (Local, rest) ...@@ -257,11 +258,13 @@ takeDir rest = (Local, rest)
takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken]) takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken])
takeType (DTIdent a : DTDot b : rest) = (InterfaceT a (Just b), rest) takeType (DTIdent a : DTDot b : rest) = (InterfaceT a (Just b), rest)
takeType (DTType tf : rest) = (tf , rest) takeType (DTType tf : DTSigning sg : rest) = (tf sg , rest)
takeType (DTIdent tn : DTComma : rest) = (Implicit, DTIdent tn : DTComma : rest) takeType (DTType tf : rest) = (tf Unspecified, rest)
takeType (DTIdent tn : [ ]) = (Implicit, DTIdent tn : [ ]) takeType (DTSigning sg : rest) = (Implicit sg , rest)
takeType (DTIdent tn : rest) = (Alias tn, rest) takeType (DTIdent tn : DTComma : rest) = (Implicit Unspecified, DTIdent tn : DTComma : rest)
takeType rest = (Implicit, rest) takeType (DTIdent tn : [ ]) = (Implicit Unspecified, DTIdent tn : [ ])
takeType (DTIdent tn : rest) = (Alias tn , rest)
takeType rest = (Implicit Unspecified, rest)
takeRanges :: [DeclToken] -> ([Range], [DeclToken]) takeRanges :: [DeclToken] -> ([Range], [DeclToken])
takeRanges [] = ([], []) takeRanges [] = ([], [])
......
...@@ -227,6 +227,7 @@ data TokenName ...@@ -227,6 +227,7 @@ data TokenName
| KW_unique | KW_unique
| KW_unsigned | KW_unsigned
| KW_use | KW_use
| KW_uwire
| KW_var | KW_var
| KW_vectored | KW_vectored
| KW_virtual | KW_virtual
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment