Commit d5a369ba by Zachary Snow

struct conversion uses packing functions to force field width

parent 9884b74a
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
module Convert.Struct (convert) where module Convert.Struct (convert) where
import Data.Hashable (hash)
import Data.Maybe (fromJust, isJust) import Data.Maybe (fromJust, isJust)
import Data.List (elemIndex, sortOn) import Data.List (elemIndex, sortOn)
import Data.Tuple (swap) import Data.Tuple (swap)
...@@ -28,7 +29,7 @@ convertDescription description = ...@@ -28,7 +29,7 @@ convertDescription description =
traverseModuleItems (traverseExprs $ traverseNestedExprs $ convertOnlyExpr structs types) $ traverseModuleItems (traverseExprs $ traverseNestedExprs $ convertOnlyExpr structs types) $
traverseModuleItems (traverseTypes $ convertType structs) $ traverseModuleItems (traverseTypes $ convertType structs) $
traverseModuleItems (traverseAsgns $ convertAsgn structs types) $ traverseModuleItems (traverseAsgns $ convertAsgn structs types) $
description description'
where where
structs = execWriter $ collectModuleItemsM structs = execWriter $ collectModuleItemsM
(collectTypesM collectType) description (collectTypesM collectType) description
...@@ -37,7 +38,24 @@ convertDescription description = ...@@ -37,7 +38,24 @@ convertDescription description =
typesB = execWriter $ collectModuleItemsM typesB = execWriter $ collectModuleItemsM
collectFunction description collectFunction description
types = Map.union typesA typesB types = Map.union typesA typesB
description' =
case description of
Part extern kw lifetime name ports items ->
Part extern kw lifetime name ports (items ++ funcs)
where funcs = map packerFn $ Map.keys structs
other -> other
-- produces a function
packerFn :: TypeFunc -> ModuleItem
packerFn structTf =
MIPackageItem $
Function Nothing (structTf []) fnName decls [retStmt]
where
Struct (Packed _) fields [] = structTf []
toInput (t, x) = Variable Input t x [] Nothing
decls = map toInput fields
retStmt = Return $ Concat $ map (Ident . snd) fields
fnName = packerFnName structTf
-- 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 ()
...@@ -123,6 +141,14 @@ collectFunction :: ModuleItem -> Writer Types () ...@@ -123,6 +141,14 @@ collectFunction :: ModuleItem -> Writer Types ()
collectFunction (MIPackageItem (Function _ t f _ _)) = tell $ Map.singleton f t collectFunction (MIPackageItem (Function _ t f _ _)) = tell $ Map.singleton f t
collectFunction _ = return () collectFunction _ = return ()
-- returns a "unique" name for the packer for a given struct type
packerFnName :: TypeFunc -> Identifier
packerFnName structTf =
"sv2v_pack_struct_" ++ str
where
val = hash $ show structTf
str = tail $ show val
convertOnlyExpr :: Structs -> Types -> Expr -> Expr convertOnlyExpr :: Structs -> Types -> Expr -> Expr
convertOnlyExpr structs types expr = convertOnlyExpr structs types expr =
snd $ convertAsgn structs types (LHSIdent "", expr) snd $ convertAsgn structs types (LHSIdent "", expr)
...@@ -234,7 +260,7 @@ convertAsgn structs types (lhs, expr) = ...@@ -234,7 +260,7 @@ convertAsgn structs types (lhs, expr) =
else if Map.notMember structTf structs then else if Map.notMember structTf structs then
Pattern items Pattern items
else else
Concat $ map packItem items Call fnName $ Args (map (Just . snd) items) []
where where
subMap = \(Just ident, subExpr) -> subMap = \(Just ident, subExpr) ->
(Just ident, convertExpr (lookupFieldType fields ident) subExpr) (Just ident, convertExpr (lookupFieldType fields ident) subExpr)
...@@ -249,9 +275,7 @@ convertAsgn structs types (lhs, expr) = ...@@ -249,9 +275,7 @@ convertAsgn structs types (lhs, expr) =
fieldNames = map snd fields fieldNames = map snd fields
itemsFieldNames = map (fromJust . fst) items itemsFieldNames = map (fromJust . fst) items
itemPosition = \(Just x, _) -> fromJust $ elemIndex x fieldNames itemPosition = \(Just x, _) -> fromJust $ elemIndex x fieldNames
packItem (Just x, e) = sizedExpr x r e fnName = packerFnName structTf
where r = lookupUnstructRange structTf x
packItem (_, itemExpr) = itemExpr
convertExpr _ other = other convertExpr _ other = other
-- try expression conversion by looking at the *innermost* type first -- try expression conversion by looking at the *innermost* type first
......
...@@ -29,6 +29,7 @@ executable sv2v ...@@ -29,6 +29,7 @@ executable sv2v
containers, containers,
directory, directory,
filepath, filepath,
hashable,
mtl mtl
other-modules: other-modules:
-- SystemVerilog modules -- SystemVerilog modules
......
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