Commit 003d4dbc by Zachary Snow

param type conversion initial cleanup

parent a47afa96
...@@ -8,8 +8,7 @@ ...@@ -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 () ...@@ -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 = ...@@ -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" ...@@ -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)) = ...@@ -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)) = ...@@ -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 $
......
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