initial version of enum conversion

src/Convert.hs

@@ -11,6 +11,7 @@ import Job (Target(..))
 
 import qualified Convert.AlwaysKW
 import qualified Convert.CaseKW
+import qualified Convert.Enum
 import qualified Convert.Logic
 import qualified Convert.Typedef
 import qualified Convert.PackedArray
@@ -21,9 +22,10 @@ type Phase = AST -> AST
 
 phases :: Target -> [Phase]
 phases YOSYS =
-    [ Convert.Typedef.convert
+    [ Convert.Enum.convert
     , Convert.PackedArray.convert
     , Convert.StarPort.convert
+    , Convert.Typedef.convert
     ]
 phases VTR =
     (phases YOSYS) ++

src/Convert/Enum.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for `enum`
+ -
+ - TODO: We do not yet properly support enums which specify the value for some,
+ - but not all items. My understanding is that they should continue in order
+ - from the previous value.
+ -}
+
+module Convert.Enum (convert) where
+
+import Text.Read (readMaybe)
+import Data.Maybe (fromMaybe)
+import Control.Monad.Writer
+import qualified Data.Set as Set
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type EnumInfo = (Maybe Type, [(Identifier, Maybe Expr)])
+type Enums = Set.Set EnumInfo
+
+convert :: AST -> AST
+convert = traverseDescriptions convertDescription
+
+defaultType :: Type
+defaultType = Logic [(Number "31", Number "0")]
+
+convertDescription :: Description -> Description
+convertDescription (description @ (Module _ _ _)) =
+    Module name ports (enumItems ++ items)
+    where
+        enumPairs = concat $ map (uncurry enumVals) $ Set.toList enums
+        enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit []) x v) enumPairs
+        (Module name ports items, enums) = runWriter $
+            traverseModuleItemsM (traverseTypesM traverseType) description
+        traverseType :: Type -> Writer Enums Type
+        traverseType (Enum t v r) = do
+            () <- tell $ Set.singleton (t, v)
+            let baseType = fromMaybe defaultType t
+            let (tf, rs) = typeRanges baseType
+            return $ tf (rs ++ r)
+        traverseType other = return other
+convertDescription other = other
+
+enumVals :: Maybe Type -> [(Identifier, Maybe Expr)] -> [(Identifier, Expr)]
+enumVals _ l = zip
+    (map fst l)
+    (tail $ scanl step (Number "-1") (map snd l))
+    where
+        step :: Expr -> Maybe Expr -> Expr
+        step _ (Just expr) = expr
+        step (Number n) Nothing =
+            case (readMaybe n) :: Maybe Int of
+                Just value -> Number (show $ value + 1)
+                Nothing -> BinOp Add (Number n) (Number "1")
+        step expr Nothing =
+            BinOp Add expr (Number "1")

src/Convert/Traverse.hs

@@ -30,6 +30,9 @@ module Convert.Traverse
 , traverseDeclsM
 , traverseDecls
 , collectDeclsM
+, traverseTypesM
+, traverseTypes
+, collectTypesM
 ) where
 
 import Data.Maybe (fromJust)
@@ -300,3 +303,28 @@ traverseDecls :: Mapper Decl -> Mapper ModuleItem
 traverseDecls = unmonad traverseDeclsM
 collectDeclsM :: Monad m => CollectorM m Decl -> CollectorM m ModuleItem
 collectDeclsM = collectify traverseDeclsM
+
+traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem
+traverseTypesM mapper item =
+    traverseDeclsM declMapper item >>= traverseExprsM exprMapper
+    where
+        exprMapper (Cast t e) = do
+            t' <- mapper t
+            -- TODO HACK: If the cast type is no longer "simple", we just drop
+            -- the case altogether. This probably doesn't work great in all
+            -- cases.
+            return $ if elem ' ' (show t')
+                then e
+                else Cast t' e
+        exprMapper other = return other
+        declMapper (Parameter  t x    e) =
+            mapper t >>= \t' -> return $ Parameter  t' x   e
+        declMapper (Localparam t x    e) =
+            mapper t >>= \t' -> return $ Localparam t' x   e
+        declMapper (Variable d t x a me) =
+            mapper t >>= \t' -> return $ Variable d t' x a me
+
+traverseTypes :: Mapper Type -> Mapper ModuleItem
+traverseTypes = unmonad traverseTypesM
+collectTypesM :: Monad m => CollectorM m Type -> CollectorM m ModuleItem
+collectTypesM = collectify traverseTypesM

src/Convert/Typedef.hs

@@ -32,19 +32,7 @@ isTypedef _ = False
 
 convertDescription :: Types -> Description -> Description
 convertDescription types description =
-    traverseModuleItems rewriteMI description
-    where
-        rt :: Type -> Type
-        rt = resolveType types
-        rewriteMI :: ModuleItem -> ModuleItem
-        rewriteMI = traverseDecls rewriteDecl . traverseExprs rewriteExpr
-        rewriteExpr :: Expr -> Expr
-        rewriteExpr (Cast t e) = Cast (rt t) e
-        rewriteExpr other = other
-        rewriteDecl :: Decl -> Decl
-        rewriteDecl (Parameter  t x    e) = Parameter  (rt t) x   e
-        rewriteDecl (Localparam t x    e) = Localparam (rt t) x   e
-        rewriteDecl (Variable d t x a me) = Variable d (rt t) x a me
+    traverseModuleItems (traverseTypes $ resolveType types) description
 
 resolveType :: Types -> Type -> Type
 resolveType _ (Reg      rs) = Reg      rs

src/Language/SystemVerilog/AST.hs

@@ -79,7 +79,7 @@ data Type
   | Implicit         [Range]
   | IntegerT
   | Enum (Maybe Type) [(Identifier, Maybe Expr)] [Range]
-  deriving Eq
+  deriving (Eq, Ord)
 
 instance Show Type where
   show (Reg      r) = "reg"   ++ (showRanges r)
@@ -212,7 +212,7 @@ data Expr
   | Mux        Expr Expr Expr
   | Bit        Expr Int
   | Cast       Type Expr
-  deriving Eq
+  deriving (Eq, Ord)
 
 data UniOp
   = Not
@@ -225,7 +225,7 @@ data UniOp
   | RedNor
   | RedXor
   | RedXnor
-  deriving Eq
+  deriving (Eq, Ord)
 
 instance Show UniOp where
   show Not     = "!"
@@ -260,7 +260,7 @@ data BinOp
   | Ge
   | ShiftAL
   | ShiftAR
-  deriving Eq
+  deriving (Eq, Ord)
 
 instance Show BinOp where
   show a = case a of

sv2v.cabal

@@ -41,6 +41,7 @@ executable sv2v
     Convert
     Convert.AlwaysKW
     Convert.CaseKW
+    Convert.Enum
     Convert.Logic
     Convert.PackedArray
     Convert.SplitPortDecl