struct conversion uses simple association lists

This commit is contained in:
Zachary Snow 2021-07-08 13:58:02 -04:00
parent 25fe57f75a
commit 4c7e9d0353
1 changed files with 14 additions and 23 deletions

View File

@ -9,18 +9,16 @@ module Convert.Struct (convert) where
import Control.Monad ((>=>), when) import Control.Monad ((>=>), when)
import Data.Either (isLeft) import Data.Either (isLeft)
import Data.List (elemIndex, find, partition) import Data.List (elemIndex, find, partition, (\\))
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Tuple (swap) import Data.Tuple (swap)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Convert.ExprUtils import Convert.ExprUtils
import Convert.Scoper import Convert.Scoper
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type StructInfo = (Type, Map.Map Identifier Range) type StructInfo = (Type, [(Identifier, Range)])
convert :: [AST] -> [AST] convert :: [AST] -> [AST]
convert = map $ traverseDescriptions convertDescription convert = map $ traverseDescriptions convertDescription
@ -74,7 +72,7 @@ convertStruct' isStruct sg fields =
-- create the mapping structure for the unstructured fields -- create the mapping structure for the unstructured fields
keys = map snd fields keys = map snd fields
unstructRanges = zip fieldHis fieldLos unstructRanges = zip fieldHis fieldLos
unstructFields = Map.fromList $ zip keys unstructRanges unstructFields = zip keys unstructRanges
-- create the unstructured type; result type takes on the signing of the -- create the unstructured type; result type takes on the signing of the
-- struct itself to preserve behavior of operations on the whole struct -- struct itself to preserve behavior of operations on the whole struct
@ -201,19 +199,16 @@ convertExpr t (Mux c e1 e2) =
e2' = convertExpr t e2 e2' = convertExpr t e2
convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) = convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
if extraNames /= Set.empty then if not (null extraNames) then
error $ "pattern " ++ show (Pattern itemsOrig) ++ error $ "pattern " ++ show (Pattern itemsOrig) ++
" has extra named fields " ++ show (Set.toList extraNames) ++ " has extra named fields " ++ show extraNames ++
" that are not in " ++ show struct " that are not in " ++ show struct
else if structIsntReady struct then else if structIsntReady struct then
Pattern items Pattern items
else else
Concat Concat $ zipWith (Cast . Left) fieldTypes (map snd items)
$ map (uncurry $ Cast . Left)
$ zip (map fst fields) (map snd items)
where where
fieldNames = map snd fields (fieldTypes, fieldNames) = unzip fields
fieldTypeMap = Map.fromList $ map swap fields
itemsNamed = itemsNamed =
-- patterns either use positions based or name/type/default -- patterns either use positions based or name/type/default
@ -228,11 +223,9 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
else else
zip (map (Right . Ident) fieldNames) (map snd itemsOrig) zip (map (Right . Ident) fieldNames) (map snd itemsOrig)
(typedItems, untypedItems) = (typedItems, untypedItems) =
partition (isLeft . fst) itemsNamed partition (isLeft . fst) $ reverse itemsNamed
(numberedItems, namedItems) = (numberedItems, namedItems) =
partition (isNumbered . fst) untypedItems partition (isNumbered . fst) untypedItems
namedItemMap = Map.fromList namedItems
typedItemMap = Map.fromList typedItems
isNumbered :: TypeOrExpr -> Bool isNumbered :: TypeOrExpr -> Bool
isNumbered (Right (Number n)) = isNumbered (Right (Number n)) =
@ -248,9 +241,7 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
++ " is out of bounds for " ++ show struct ++ " is out of bounds for " ++ show struct
isNumbered _ = False isNumbered _ = False
extraNames = Set.difference extraNames = map (getName . right . fst) namedItems \\ fieldNames
(Set.fromList $ map (getName . right . fst) namedItems)
(Map.keysSet fieldTypeMap)
right = \(Right x) -> x right = \(Right x) -> x
getName :: Expr -> Identifier getName :: Expr -> Identifier
getName (Ident x) = x getName (Ident x) = x
@ -282,12 +273,12 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
"' from struct definition " ++ show struct ++ "' from struct definition " ++ show struct ++
" in struct pattern " ++ show (Pattern itemsOrig) " in struct pattern " ++ show (Pattern itemsOrig)
where where
valueByName = Map.lookup (Right $ Ident fieldName) namedItemMap valueByName = lookup (Right $ Ident fieldName) namedItems
valueByType = Map.lookup (Left fieldType) typedItemMap valueByType = lookup (Left fieldType) typedItems
valueDefault = Map.lookup (Left UnknownType) typedItemMap valueDefault = lookup (Left UnknownType) typedItems
valueByIndex = fmap snd $ find (indexCheck . fst) numberedItems valueByIndex = fmap snd $ find (indexCheck . fst) numberedItems
fieldType = fieldTypeMap Map.! fieldName fieldType = fst $ fields !! fieldIndex
Just fieldIndex = elemIndex fieldName fieldNames Just fieldIndex = elemIndex fieldName fieldNames
isStruct :: Type -> Bool isStruct :: Type -> Bool
@ -513,7 +504,7 @@ lookupFieldInfo struct fieldName =
Just fieldType = maybeFieldType Just fieldType = maybeFieldType
dims = snd $ typeRanges fieldType dims = snd $ typeRanges fieldType
Just (_, unstructRanges) = convertStruct struct Just (_, unstructRanges) = convertStruct struct
Just bounds = Map.lookup fieldName unstructRanges Just bounds = lookup fieldName unstructRanges
-- attempts to convert based on the assignment-like contexts of TF arguments -- attempts to convert based on the assignment-like contexts of TF arguments
convertCall :: Scopes Type -> Expr -> Args -> Args convertCall :: Scopes Type -> Expr -> Args -> Args