From 7ee8d0cb52b3e9c08474365db4466d94d478cd2b Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Thu, 2 Jun 2022 21:43:59 +1000 Subject: keep on hacking renamed --- src/HaskellCodeExplorer/AST/RenamedSource.hs | 178 ++++++--------------------- src/HaskellCodeExplorer/GhcUtils.hs | 13 +- 2 files changed, 43 insertions(+), 148 deletions(-) diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs index cb0f132..bdbed89 100644 --- a/src/HaskellCodeExplorer/AST/RenamedSource.hs +++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs @@ -204,70 +204,46 @@ hsRecFieldPatNames :: HsRecField' (FieldOcc Name) (LPat Name) -> [NameOccurrence #endif hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) hsExprNames :: LHsExpr GhcRn -> [NameOccurrence] -#else -hsExprNames :: LHsExpr Name -> [NameOccurrence] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) hsExprNames (L _span (HsVar _ name)) = -#else -hsExprNames (L _span (HsVar name)) = -#endif [ NameOccurrence { locatedName = Just <$> reLocN name , description = "HsVar" , isBinder = False } ] -hsExprNames (L span (ExplicitList _ exprs)) +hsExprNames lhe@(L _ (ExplicitList _ exprs)) | null exprs = [ NameOccurrence - { locatedName = L span $ Just nilDataConName + { locatedName = L (getLocA lhe) $ Just nilDataConName , description = "ExplicitList" , isBinder = False } ] | otherwise = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) hsExprNames (L _span (RecordCon _ name _)) = -#else -hsExprNames (L _span (RecordCon name _conLike _instFun _binds)) = -#endif [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "RecordCon" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -hsExprNames (L _span (HsRecFld _ (Unambiguous name (L span _)))) = -#else -hsExprNames (L _span (HsRecFld (Unambiguous (L span _) name))) = -#endif +hsExprNames (L _span (HsRecFld _ (Unambiguous name located))) = [ NameOccurrence - { locatedName = L span (Just name) + { locatedName = L (getLocA located) (Just name) , description = "HsRecFld" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -hsExprNames (L _span (HsRecFld _ (Ambiguous _name (L span _)))) = -#else -hsExprNames (L _span (HsRecFld (Ambiguous (L span _) _name))) = -#endif +hsExprNames (L _span (HsRecFld _ (Ambiguous _name located))) = [ NameOccurrence - { locatedName = L span Nothing + { locatedName = L (getLocA located) Nothing , description = "HsRecFld" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -hsExprNames (L span (HsRnBracketOut _ (VarBr _ quote name) _)) = -#else -hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) = -#endif - case span of +hsExprNames lhr@(L span (HsRnBracketOut _ (VarBr _ quote name) _)) = + case getLocA lhr of RealSrcSpan realSpan _ -> let start = realSrcSpanStart realSpan end = realSrcSpanEnd realSpan @@ -280,9 +256,9 @@ hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) = (srcLocFile start) (srcLocLine start) (srcLocCol start + offset) - span' = RealSrcSpan $ mkRealSrcSpan start' end + span' = RealSrcSpan (mkRealSrcSpan start' end) Nothing in [ NameOccurrence - { locatedName = L span' (Just name) + { locatedName = L span' (Just $ unLoc name) , description = "VarBr" , isBinder = False } @@ -290,52 +266,30 @@ hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) = _ -> [] hsExprNames _ = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) matchGroupNames :: MatchGroup GhcRn (LHsExpr GhcRn) -> [NameOccurrence] -#else -matchGroupNames :: MatchGroup Name (LHsExpr Name) -> [NameOccurrence] -#endif matchGroupNames = -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) . -#else - mapMaybe (fmap toNameOcc . matchFixityName . m_fixity . unLoc) . -#endif unLoc . mg_alts where -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) --matchContextName :: HsMatchContext Name -> Maybe (Located Name) matchContextName (FunRhs name _ _bool) = Just name matchContextName _ = Nothing -#else - --matchFixityName :: MatchFixity Name -> Maybe (Located Name) - matchFixityName NonFunBindMatch = Nothing - matchFixityName (FunBindMatch name _bool) = Just name -#endif - --toNameOcc :: Located Name -> NameOccurrence + --toNameOcc :: LIdP GhcRn -> NameOccurrence toNameOcc n = NameOccurrence - {locatedName = Just <$> n, description = "Match", isBinder = True} + {locatedName = Just <$> reLocN n, description = "Match", isBinder = True} -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) bindNames :: LHsBindLR GhcRn GhcRn -> [NameOccurrence] -#else -bindNames :: LHsBindLR Name Name -> [NameOccurrence] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) bindNames (L _span (PatSynBind _ PSB {..})) = -#else -bindNames (L _span (PatSynBind PSB {..})) = -#endif [ NameOccurrence - { locatedName = Just <$> psb_id + { locatedName = Just <$> reLocN psb_id , description = "PatSynBind" , isBinder = True } ] bindNames _ = [] -hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence] +hsPatSynDetailsNames :: HsPatSynDetails GhcRn -> [NameOccurrence] hsPatSynDetailsNames = map (\name -> @@ -363,30 +317,30 @@ importNames = patNames :: LPat GhcRn -> [NameOccurrence] -patNames (ghcDL -> (L _span (VarPat _ name))) = +patNames (L _span (VarPat _ name)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "VarPat" , isBinder = True } ] -patNames (ghcDL -> (L _span (ConPat _ name _))) = +patNames (L _span (ConPat _ name _)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "ConPatIn" , isBinder = False } ] -patNames (ghcDL -> (L _span (AsPat _ name _))) = +patNames (L _span (AsPat _ name _)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "AsPat" , isBinder = True } ] -patNames (ghcDL -> (L _span (NPlusKPat _ name _ _ _ _))) = +patNames (L _span (NPlusKPat _ name _ _ _ _)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "NPlusKPat" , isBinder = True } @@ -394,96 +348,56 @@ patNames (ghcDL -> (L _span (NPlusKPat _ name _ _ _ _))) = patNames _ = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) sigNames :: LSig GhcRn -> [NameOccurrence] -#else -sigNames :: LSig Name -> [NameOccurrence] -#endif - -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) sigNames (L _span (TypeSig _ names _)) = -#else -sigNames (L _span (TypeSig names _)) = -#endif map (\n -> NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "TypeSig" , isBinder = False }) names -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -sigNames (L _span (PatSynSig _ names _)) = map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names -#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) -sigNames (L _span (PatSynSig names _)) = map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names -#else -sigNames (L _span (PatSynSig name _)) = - [ NameOccurrence - { locatedName = Just <$> name - , description = "PatSynSig" - , isBinder = False - } - ] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (PatSynSig _ names _)) = + map (\name -> NameOccurrence (Just <$> reLocN name) "PatSynSig" False) names sigNames (L _span (ClassOpSig _ _ names _)) = -#else -sigNames (L _span (ClassOpSig _ names _)) = -#endif map (\n -> NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "ClassOpSig" , isBinder = True }) names -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) sigNames (L _span (FixSig _ (FixitySig _ names _))) = -#else -sigNames (L _span (FixSig (FixitySig names _))) = -#endif map (\n -> NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "FixitySig" , isBinder = False }) names -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) sigNames (L _span (InlineSig _ name _)) = -#else -sigNames (L _span (InlineSig name _)) = -#endif [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "InlineSig" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) sigNames (L _span (SpecSig _ name _ _)) = -#else -sigNames (L _span (SpecSig name _ _)) = -#endif [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "SpecSig" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) sigNames (L _span (MinimalSig _ _ (L _ boolFormula))) = -#else -sigNames (L _span (MinimalSig _ (L _ boolFormula))) = -#endif map (\n -> NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "MinimalSig" , isBinder = False }) . @@ -497,55 +411,33 @@ sigNames (L _span (MinimalSig _ (L _ boolFormula))) = boolFormulaNames (Parens (L _ f)) = boolFormulaNames f sigNames (L _ _) = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) hsTypeNames :: LHsType GhcRn -> [NameOccurrence] -#else -hsTypeNames :: LHsType Name -> [NameOccurrence] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) hsTypeNames (L _span (HsTyVar _ _promoted name)) = -#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) -hsTypeNames (L _span (HsTyVar _promoted name)) = -#else -hsTypeNames (L _span (HsTyVar name)) = -#endif [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "HsTyVar" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -hsTypeNames (L span (HsTyLit _ lit)) = -#else -hsTypeNames (L span (HsTyLit lit)) = -#endif +hsTypeNames lht@(L span (HsTyLit _ lit)) = let kind = case lit of HsNumTy _ _ -> naturalTy HsStrTy _ _ -> typeSymbolKind in [ TyLitOccurrence - { locatedName = L span Nothing + { locatedName = L (getLocA lht) Nothing , description = "HsTyLit" , kind = kind } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) hsTypeNames (L _span (HsOpTy _ _ name _)) = -#else -hsTypeNames (L _span (HsOpTy _ name _)) = -#endif [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "HsOpTy" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) hsTypeNames (L span (HsTupleTy _ tupleSort types)) -#else -hsTypeNames (L span (HsTupleTy tupleSort types)) -#endif | null types = let sort = case tupleSort of diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs index 461344f..99cf7b4 100644 --- a/src/HaskellCodeExplorer/GhcUtils.hs +++ b/src/HaskellCodeExplorer/GhcUtils.hs @@ -123,6 +123,7 @@ import GHC , HsDataDefn(..) , NewOrData(..) , Id + , rdrNameFieldOcc , HsGroup(..) , HsBindLR(..) , HsValBindsLR(..) @@ -480,14 +481,16 @@ hsGroupVals hsGroup = XValBindsLR (NValBinds binds _) -> concatMap (bagToList . snd) binds _ -> [] -hsPatSynDetails :: HsPatSynDetails GhcRn -> [Name] +hsPatSynDetails :: HsPatSynDetails GhcRn -> [Located Name] hsPatSynDetails patDetails = case patDetails of - InfixCon name1 name2 -> [unLoc name1, unLoc name2] - PrefixCon _ fields -> unLoc <$> fields + InfixCon name1 name2 -> [reLocN name1, reLocN name2] + PrefixCon _ fields -> reLocN <$> fields RecCon fields -> concatMap - (\field -> [extFieldOcc $ recordPatSynField field, - unLoc $ recordPatSynPatVar field]) + (\field -> [ + L ((getLocA . rdrNameFieldOcc . recordPatSynField) field) + (extFieldOcc $ recordPatSynField field), + reLocN $ recordPatSynPatVar field]) fields #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) -- cgit v1.2.3