on master help sign in
Remove redundant calls to addNames in toSrcType
d8a49c0Evan Czaplicki
compiler/Type/Type.hs+12−9
@@ -376,10 +376,13 @@ instance Crawl Descriptor where
376
376
377toSrcType :: Variable -> IO T.CanonicalType
377toSrcType :: Variable -> IO T.CanonicalType
378toSrcType var =
378toSrcType var =
379− do desc <- UF.descriptor =<< addNames var
379+ go =<< addNames var
380− srcType <- maybe (backupSrcType desc) termToSrcType (structure desc)
381− return $ maybe srcType (\name -> T.Aliased name srcType) (alias desc)
382 where
380 where
381+ go v = do
382+ desc <- UF.descriptor v
383+ srcType <- maybe (backupSrcType desc) termToSrcType (structure desc)
384+ return $ maybe srcType (\name -> T.Aliased name srcType) (alias desc)
385+
383 backupSrcType desc =
386 backupSrcType desc =
384 case name desc of
387 case name desc of
385 Just v@(Var.Canonical _ x@(c:_))
388 Just v@(Var.Canonical _ x@(c:_))
@@ -394,22 +397,22 @@ toSrcType var =
394 termToSrcType term =
397 termToSrcType term =
395 case term of
398 case term of
396 App1 a b -> do
399 App1 a b -> do
397− a' <- toSrcType a
400+ a' <- go a
398− b' <- toSrcType b
401+ b' <- go b
399 case a' of
402 case a' of
400 T.App f args -> return $ T.App f (args ++ [b'])
403 T.App f args -> return $ T.App f (args ++ [b'])
401 _ -> return $ T.App a' [b']
404 _ -> return $ T.App a' [b']
402
405
403− Fun1 a b -> T.Lambda <$> toSrcType a <*> toSrcType b
406+ Fun1 a b -> T.Lambda <$> go a <*> go b
404
407
405− Var1 a -> toSrcType a
408+ Var1 a -> go a
406
409
407 EmptyRecord1 -> return $ T.Record [] Nothing
410 EmptyRecord1 -> return $ T.Record [] Nothing
408
411
409 Record1 tfields extension -> do
412 Record1 tfields extension -> do
410− fields' <- traverse (mapM toSrcType) tfields
413+ fields' <- traverse (mapM go) tfields
411 let fields = concat [ map ((,) name) ts | (name,ts) <- Map.toList fields' ]
414 let fields = concat [ map ((,) name) ts | (name,ts) <- Map.toList fields' ]
412− ext' <- dealias <$> toSrcType extension
415+ ext' <- dealias <$> go extension
413 return $ case ext' of
416 return $ case ext' of
414 T.Record fs ext -> T.Record (fs ++ fields) ext
417 T.Record fs ext -> T.Record (fs ++ fields) ext
415 T.Var _ -> T.Record fields (Just ext')
418 T.Var _ -> T.Record fields (Just ext')