Tidy up resolveNamedTypes.
This commit is contained in:
parent
f102d8e7ef
commit
8545b08aee
|
@ -20,7 +20,6 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
module SimplifyTypes (simplifyTypes) where
|
module SimplifyTypes (simplifyTypes) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.Set as Set
|
|
||||||
|
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
import Metadata
|
import Metadata
|
||||||
|
@ -30,19 +29,22 @@ import Traversal
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
simplifyTypes :: [Pass]
|
simplifyTypes :: [Pass]
|
||||||
simplifyTypes = [resolveAllNamedTypes]
|
simplifyTypes
|
||||||
|
= [ resolveNamedTypes
|
||||||
resolveAllNamedTypes :: Pass
|
]
|
||||||
resolveAllNamedTypes = Pass
|
|
||||||
{passCode = \t -> (get >>= resolveNamedTypes >>= put) >> resolveNamedTypes t
|
|
||||||
,passName = "Resolve types in AST and state"
|
|
||||||
,passPre = Set.fromList $ Prop.agg_namesDone ++ [Prop.expressionTypesChecked, Prop.processTypesChecked]
|
|
||||||
,passPost = Set.fromList [Prop.typesResolvedInAST, Prop.typesResolvedInState]
|
|
||||||
,passEnabled = const True}
|
|
||||||
|
|
||||||
-- | Turn named data types into their underlying types.
|
-- | Turn named data types into their underlying types.
|
||||||
resolveNamedTypes :: PassType
|
resolveNamedTypes :: Pass
|
||||||
resolveNamedTypes = applyDepthM doType
|
resolveNamedTypes
|
||||||
|
= pass "Resolve user-defined types"
|
||||||
|
(Prop.agg_namesDone
|
||||||
|
++ [Prop.expressionTypesChecked, Prop.processTypesChecked])
|
||||||
|
[Prop.typesResolvedInAST, Prop.typesResolvedInState]
|
||||||
|
(\t -> do get >>= resolve >>= put
|
||||||
|
resolve t)
|
||||||
|
where
|
||||||
|
resolve :: PassType
|
||||||
|
resolve = applyDepthM doType
|
||||||
where
|
where
|
||||||
doType :: A.Type -> PassM A.Type
|
doType :: A.Type -> PassM A.Type
|
||||||
doType t@(A.UserDataType _) = underlyingType emptyMeta t
|
doType t@(A.UserDataType _) = underlyingType emptyMeta t
|
||||||
|
|
Loading…
Reference in New Issue
Block a user