Commit 295ac649 by Zachary Snow

package item conversions preserve ordering (resolves #36)

parent dd3a7e68
...@@ -9,13 +9,12 @@ module Convert.NestPI (convert) where ...@@ -9,13 +9,12 @@ module Convert.NestPI (convert) where
import Control.Monad.State import Control.Monad.State
import Control.Monad.Writer import Control.Monad.Writer
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Convert.Traverse import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type PIs = Map.Map Identifier PackageItem type PIs = [(Identifier, PackageItem)]
type Idents = Set.Set Identifier type Idents = Set.Set Identifier
convert :: [AST] -> [AST] convert :: [AST] -> [AST]
...@@ -28,7 +27,7 @@ convert asts = ...@@ -28,7 +27,7 @@ convert asts =
then curr then curr
else nest next else nest next
where where
next = evalState (traverseM curr) Map.empty next = evalState (traverseM curr) []
traverseM = traverseDescriptionsM traverseDescriptionM traverseM = traverseDescriptionsM traverseDescriptionM
isPI :: Description -> Bool isPI :: Description -> Bool
isPI (PackageItem item) = piName item /= Nothing isPI (PackageItem item) = piName item /= Nothing
...@@ -39,16 +38,16 @@ traverseDescriptionM :: Description -> State PIs Description ...@@ -39,16 +38,16 @@ traverseDescriptionM :: Description -> State PIs Description
traverseDescriptionM (PackageItem item) = do traverseDescriptionM (PackageItem item) = do
() <- case piName item of () <- case piName item of
Nothing -> return () Nothing -> return ()
Just ident -> modify $ Map.insert ident item Just ident -> modify $ flip (++) [(ident, item)]
return $ PackageItem item return $ PackageItem item
traverseDescriptionM (orig @ (Part extern kw lifetime name ports items)) = do traverseDescriptionM (orig @ (Part extern kw lifetime name ports items)) = do
tfs <- get tfs <- get
let neededPIs = Set.difference let neededPIs = Set.difference
(Set.union usedPIs $ (Set.union usedPIs $
Set.filter (isPrefixOf "import ") $ Map.keysSet tfs) Set.filter (isPrefixOf "import ") $ Set.fromList $ map fst tfs)
existingPIs existingPIs
let newItems = map MIPackageItem $ Map.elems $ let newItems = map MIPackageItem $ map snd $
Map.restrictKeys tfs neededPIs filter (\(x, _) -> Set.member x neededPIs) tfs
return $ Part extern kw lifetime name ports (newItems ++ items) return $ Part extern kw lifetime name ports (newItems ++ items)
where where
existingPIs = execWriter $ collectModuleItemsM collectPIsM orig existingPIs = execWriter $ collectModuleItemsM collectPIsM orig
......
...@@ -33,7 +33,7 @@ import Convert.Traverse ...@@ -33,7 +33,7 @@ import Convert.Traverse
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type Packages = Map.Map Identifier PackageItems type Packages = Map.Map Identifier PackageItems
type PackageItems = Map.Map Identifier PackageItem type PackageItems = [(Identifier, PackageItem)]
type Idents = Set.Set Identifier type Idents = Set.Set Identifier
convert :: [AST] -> [AST] convert :: [AST] -> [AST]
...@@ -64,13 +64,13 @@ convertFile packages ast = ...@@ -64,13 +64,13 @@ convertFile packages ast =
globalPackageItems :: Identifier -> PackageItems -> [PackageItem] globalPackageItems :: Identifier -> PackageItems -> [PackageItem]
globalPackageItems name items = globalPackageItems name items =
map (prefixPackageItem name (packageItemIdents items)) (Map.elems items) map (prefixPackageItem name (packageItemIdents items)) (map snd items)
packageItemIdents :: PackageItems -> Idents packageItemIdents :: PackageItems -> Idents
packageItemIdents items = packageItemIdents items =
Set.union Set.union
(Map.keysSet items) (Set.fromList $ map fst items)
(Set.unions $ map packageItemSubIdents $ Map.elems items) (Set.unions $ map (packageItemSubIdents . snd) items)
where where
packageItemSubIdents :: PackageItem -> Idents packageItemSubIdents :: PackageItem -> Idents
packageItemSubIdents (Typedef (Enum _ enumItems _) _) = packageItemSubIdents (Typedef (Enum _ enumItems _) _) =
...@@ -114,14 +114,14 @@ collectDescriptionM :: Description -> Writer Packages () ...@@ -114,14 +114,14 @@ collectDescriptionM :: Description -> Writer Packages ()
collectDescriptionM (Package _ name items) = collectDescriptionM (Package _ name items) =
if any isImport items if any isImport items
then return () then return ()
else tell $ Map.singleton name itemMap else tell $ Map.singleton name itemList
where where
itemMap = Map.unions $ map toMap items itemList = concatMap toPackageItems items
toMap :: PackageItem -> PackageItems toPackageItems :: PackageItem -> PackageItems
toMap item = toPackageItems item =
case piName item of case piName item of
Nothing -> Map.empty Nothing -> []
Just x -> Map.singleton x item Just x -> [(x, item)]
isImport :: PackageItem -> Bool isImport :: PackageItem -> Bool
isImport (Import _ _) = True isImport (Import _ _) = True
isImport _ = False isImport _ = False
...@@ -151,7 +151,7 @@ traverseModuleItem existingItemNames packages (MIPackageItem (Import x y)) = ...@@ -151,7 +151,7 @@ traverseModuleItem existingItemNames packages (MIPackageItem (Import x y)) =
filterer itemName = case y of filterer itemName = case y of
Nothing -> Set.notMember itemName existingItemNames Nothing -> Set.notMember itemName existingItemNames
Just ident -> ident == itemName Just ident -> ident == itemName
items = map snd $ filter (filterer . fst) $ Map.toList packageItems items = map snd $ filter (filterer . fst) $ packageItems
traverseModuleItem _ _ item = traverseModuleItem _ _ item =
(traverseExprs $ traverseNestedExprs traverseExpr) $ (traverseExprs $ traverseNestedExprs traverseExpr) $
(traverseStmts traverseStmt) $ (traverseStmts traverseStmt) $
......
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