luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

param type conversion initial cleanup

This commit is contained in:
Zachary Snow 2021-06-07 23:39:26 -04:00
parent a47afa96b8
commit 003d4dbc4e
1 changed files with 8 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Convert/ParamType.hs
View File

@ -8,8 +8,7 @@
module Convert.ParamType (convert) where module Convert.ParamType (convert) where
import Control.Monad.Writer.Strict import Control.Monad.Writer.Strict
import Data.Either (isLeft) import Data.Either (isRight)
import Data.Maybe (isJust, fromJust)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
@ -176,17 +175,13 @@ collectDescriptionM :: Description -> Writer Info ()
collectDescriptionM (part @ (Part _ _ _ _ name _ _)) = collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
tell $ Map.singleton name maybeTypeMap tell $ Map.singleton name maybeTypeMap
where where
params = execWriter $ maybeTypeMap = Map.fromList $ execWriter $
collectModuleItemsM (collectDeclsM collectDeclM) part collectModuleItemsM (collectDeclsM collectDeclM) part
maybeTypeMap = Map.fromList $ collectDeclM :: Decl -> Writer [(Identifier, Maybe Type)] ()
map (\(x, y) -> (x, fromJust y)) $
filter (isJust . snd) params
collectDeclM :: Decl -> Writer [(Identifier, Maybe (Maybe Type))] ()
collectDeclM (Param Parameter _ x _) = tell [(x, Nothing)]
collectDeclM (ParamType Parameter x v) = collectDeclM (ParamType Parameter x v) =
if v == UnknownType if v == UnknownType
then tell [(x, Just Nothing)] then tell [(x, Nothing)]
else tell [(x, Just $ Just v)] else tell [(x, Just v)]
collectDeclM _ = return () collectDeclM _ = return ()
collectDescriptionM _ = return () collectDescriptionM _ = return ()
@ -216,8 +211,6 @@ typeIsUnresolved =
(collectNestedExprsM collectUnresolvedExprM) (collectNestedExprsM collectUnresolvedExprM)
where where
collectUnresolvedExprM :: Expr -> Writer Any () collectUnresolvedExprM :: Expr -> Writer Any ()
collectUnresolvedExprM PSIdent{} = tell $ Any True
collectUnresolvedExprM CSIdent{} = tell $ Any True
collectUnresolvedExprM DimsFn {} = tell $ Any True collectUnresolvedExprM DimsFn {} = tell $ Any True
collectUnresolvedExprM DimFn {} = tell $ Any True collectUnresolvedExprM DimFn {} = tell $ Any True
collectUnresolvedExprM Dot {} = tell $ Any True collectUnresolvedExprM Dot {} = tell $ Any True
@ -249,13 +242,8 @@ addedParamTypeName paramName var = paramName ++ '_' : var ++ "_type"
-- attempt to rewrite instantiations with type parameters -- attempt to rewrite instantiations with type parameters
convertModuleItemM :: Info -> ModuleItem -> Writer Instances ModuleItem convertModuleItemM :: Info -> ModuleItem -> Writer Instances ModuleItem
convertModuleItemM info (orig @ (Instance m bindings x r p)) = convertModuleItemM info (orig @ (Instance m bindings x r p)) =
if Map.notMember m info then if Map.notMember m info || Map.null maybeTypeMap then
return orig return orig
else if Map.null maybeTypeMap then
return orig
else if any (isLeft . snd) bindings' then
error $ "param type resolution left type params: " ++ show orig
++ " converted to: " ++ show bindings'
else if any (not . isSimpleType . fst) resolvedTypes then else if any (not . isSimpleType . fst) resolvedTypes then
return orig return orig
else do else do
@ -263,7 +251,7 @@ convertModuleItemM info (orig @ (Instance m bindings x r p)) =
let m' = moduleInstanceName m resolvedTypes let m' = moduleInstanceName m resolvedTypes
return $ Generate $ map GenModuleItem $ return $ Generate $ map GenModuleItem $
map (MIPackageItem . Decl) addedDecls ++ map (MIPackageItem . Decl) addedDecls ++
[Instance m' (additionalBindings ++ bindings') x r p] [Instance m' (additionalBindings ++ exprBindings) x r p]
where where
maybeTypeMap = info Map.! m maybeTypeMap = info Map.! m
-- determine the types corresponding to each type parameter -- determine the types corresponding to each type parameter
@ -278,8 +266,7 @@ convertModuleItemM info (orig @ (Instance m bindings x r p)) =
Just $ prepareTypeExprs x paramName t Just $ prepareTypeExprs x paramName t
-- leave only the normal expression params behind -- leave only the normal expression params behind
isParamType = flip Map.member maybeTypeMap exprBindings = filter (isRight . snd) bindings
bindings' = filter (not . isParamType . fst) bindings
-- create additional parameters needed to specify existing type params -- create additional parameters needed to specify existing type params
additionalBindings = concatMap makeAddedParams $ additionalBindings = concatMap makeAddedParams $