Commit 4c7e9d03 by Zachary Snow

struct conversion uses simple association lists

parent 25fe57f7
...@@ -9,18 +9,16 @@ module Convert.Struct (convert) where ...@@ -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 = ...@@ -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) = ...@@ -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) = ...@@ -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) = ...@@ -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) = ...@@ -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 = ...@@ -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
......
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