diff options
Diffstat (limited to 'src/HaskellCodeExplorer/AST')
| -rw-r--r-- | src/HaskellCodeExplorer/AST/RenamedSource.hs | 198 |
1 files changed, 56 insertions, 142 deletions
diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs index bdbed89..89c84ac 100644 --- a/src/HaskellCodeExplorer/AST/RenamedSource.hs +++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs @@ -15,7 +15,7 @@ import GHC.Types.Basic (TupleSort(..)) -- import BooleanFormula (BooleanFormula(..)) import GHC.Data.BooleanFormula (BooleanFormula(..)) import Data.Generics (Data, everything, extQ, mkQ) -import Data.Maybe (Maybe(..), mapMaybe) +import Data.Maybe (mapMaybe) import qualified Data.Text as T (Text) import GHC ( AmbiguousFieldOcc(..) @@ -29,6 +29,7 @@ import GHC , FieldOcc(..) , FixitySig(..) , ForeignDecl(..) + , FunDep(..) , GenLocated(..) , getLocA , HsBindLR(..) @@ -41,7 +42,6 @@ import GHC , HsRecField'(..) , HsTupleSort(..) , HsTyLit(..) - , HsTyPats , HsTyVarBndr(..) , HsType(..) , IE(..) @@ -86,7 +86,7 @@ import GHC -- import HsExtension (GhcRn) import GHC.Hs.Extension (GhcRn) #endif -import HaskellCodeExplorer.GhcUtils (hsPatSynDetails, ieLocNames, ghcDL) +import HaskellCodeExplorer.GhcUtils (hsPatSynDetails, ieLocNames) import Prelude hiding (span) -- import TysWiredIn import GHC.Builtin.Types @@ -121,34 +121,31 @@ namesFromRenamedSource :: (Data a) => a -> [NameOccurrence] namesFromRenamedSource = everything (++) - ([] `mkQ` hsExprNames `extQ` matchGroupNames `extQ` bindNames `extQ` - patNames `extQ` - sigNames `extQ` - hsTypeNames `extQ` - tyClDeclNames `extQ` - familyDeclNames `extQ` -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) - familyEqNames `extQ` - dataEqNames `extQ` -#else - tyFamilyEqNames `extQ` - tyFamilyDefEqNames `extQ` - dataFamInstDeclNames `extQ` -#endif - conDeclNames `extQ` - importNames `extQ` - hsTyVarBndrNames `extQ` - hsPatSynDetailsNames `extQ` - conDeclFieldNames `extQ` - hsRecFieldExprNames `extQ` - hsRecAmbFieldExprNames `extQ` - hsRecFieldPatNames `extQ` - foreignDeclNames `extQ` - roleAnnotationNames `extQ` - injectivityAnnotationNames) + ([] + `mkQ` hsExprNames + `extQ` matchGroupNames + `extQ` bindNames + `extQ` patNames + `extQ` sigNames + `extQ` hsTypeNames + `extQ` tyClDeclNames + `extQ` familyDeclNames + `extQ` familyEqNames + `extQ` dataEqNames + `extQ` conDeclNames + `extQ` importNames + `extQ` hsTyVarBndrNames + `extQ` hsPatSynDetailsNames + `extQ` conDeclFieldNames + `extQ` hsRecFieldExprNames + `extQ` hsRecAmbFieldExprNames + `extQ` hsRecFieldPatNames + `extQ` foreignDeclNames + `extQ` roleAnnotationNames + `extQ` injectivityAnnotationNames + ) fieldOccName :: Bool -> FieldOcc GhcRn -> NameOccurrence -fieldOccName _ (XFieldOcc _) = undefined fieldOccName isBinder (FieldOcc name located) = NameOccurrence { locatedName = L (getLocA located) (Just name) @@ -156,40 +153,20 @@ fieldOccName isBinder (FieldOcc name located) = , isBinder = isBinder } -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) conDeclFieldNames :: ConDeclField GhcRn -> [NameOccurrence] -#else -conDeclFieldNames :: ConDeclField Name -> [NameOccurrence] -#endif conDeclFieldNames ConDeclField {..} = map (fieldOccName True . unLoc) cd_fld_names -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -conDeclFieldNames _ = [] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) hsRecFieldExprNames :: HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence] -#else -hsRecFieldExprNames :: HsRecField' (FieldOcc Name) (LHsExpr Name) -> [NameOccurrence] -#endif hsRecFieldExprNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) hsRecAmbFieldExprNames :: HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence] -#else -hsRecAmbFieldExprNames :: HsRecField' (AmbiguousFieldOcc Name) (LHsExpr Name) -> [NameOccurrence] -#endif hsRecAmbFieldExprNames HsRecField {..} = let (L span recField) = hsRecFieldLbl mbName = case recField of Ambiguous _ _ -> Nothing -#if MIN_VERSION_GLASGOW_HASKELL(8,6,3,0) Unambiguous name _ -> Just name - _ -> Nothing -#else - Unambiguous _ name -> Just name -#endif in [ NameOccurrence { locatedName = L span mbName , description = "AmbiguousFieldOcc" @@ -242,7 +219,7 @@ hsExprNames (L _span (HsRecFld _ (Ambiguous _name located))) = , isBinder = False } ] -hsExprNames lhr@(L span (HsRnBracketOut _ (VarBr _ quote name) _)) = +hsExprNames lhr@(L _ (HsRnBracketOut _ (VarBr _ quote name) _)) = case getLocA lhr of RealSrcSpan realSpan _ -> let start = realSrcSpanStart realSpan @@ -419,11 +396,12 @@ hsTypeNames (L _span (HsTyVar _ _promoted name)) = , isBinder = False } ] -hsTypeNames lht@(L span (HsTyLit _ lit)) = +hsTypeNames lht@(L _ (HsTyLit _ lit)) = let kind = case lit of HsNumTy _ _ -> naturalTy HsStrTy _ _ -> typeSymbolKind + HsCharTy _ _ -> typeSymbolKind in [ TyLitOccurrence { locatedName = L (getLocA lht) Nothing , description = "HsTyLit" @@ -437,14 +415,14 @@ hsTypeNames (L _span (HsOpTy _ _ name _)) = , isBinder = False } ] -hsTypeNames (L span (HsTupleTy _ tupleSort types)) +hsTypeNames lht@(L _ (HsTupleTy _ tupleSort types)) | null types = let sort = case tupleSort of HsUnboxedTuple -> UnboxedTuple HsBoxedOrConstraintTuple -> BoxedTuple in [ NameOccurrence - { locatedName = L span (Just $ tupleTyConName sort 0) + { locatedName = L (getLocA lht) (Just $ tupleTyConName sort 0) , description = "HsTupleTy" , isBinder = False } @@ -455,23 +433,25 @@ hsTypeNames (L span (HsTupleTy _ tupleSort types)) --hsTypeNames (L span (HsExplicitTupleTy _kind types)) = ... hsTypeNames _ = [] - -hsTyVarBndrNames :: HsTyVarBndr flag GhcRn -> [NameOccurrence] +-- the flag in HsTyVarBndr flag GhcRn can be either () (for visible +-- cases) or Specificity (for invisible cases). I'm guessing we only +-- need to handle the visible cases, but it's trivial to replicate +-- this function for invisible cases +hsTyVarBndrNames :: HsTyVarBndr () GhcRn -> [NameOccurrence] hsTyVarBndrNames (UserTyVar _ _ n) = [ NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "UserTyVar" , isBinder = True } ] hsTyVarBndrNames (KindedTyVar _ _ n _) = [ NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "KindedTyVar" , isBinder = True } ] -hsTyVarBndrNames _ = [] #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) @@ -481,133 +461,82 @@ tyClDeclNames :: LTyClDecl Name -> [NameOccurrence] #endif tyClDeclNames (L _span DataDecl {..}) = [ NameOccurrence - { locatedName = Just <$> tcdLName + { locatedName = Just <$> reLocN tcdLName , description = "DataDecl" , isBinder = True } ] tyClDeclNames (L _span SynDecl {..}) = [ NameOccurrence - { locatedName = Just <$> tcdLName + { locatedName = Just <$> reLocN tcdLName , description = "SynDecl" , isBinder = True } ] tyClDeclNames (L _span ClassDecl {..}) = NameOccurrence - { locatedName = Just <$> tcdLName + { locatedName = Just <$> reLocN tcdLName , description = "ClassDecl" , isBinder = True } : - concatMap - ((\(names1, names2) -> map toNameOcc names1 ++ map toNameOcc names2) . unLoc) - tcdFDs + concatMap (go . unLoc) tcdFDs where - toNameOcc :: Located Name -> NameOccurrence + -- toNameOcc :: Located Name -> NameOccurrence toNameOcc n = NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "FunDep" , isBinder = False } + go (FunDep _ names1 names2) = map toNameOcc names1 ++ map toNameOcc names2 + go _ = [] tyClDeclNames _ = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) familyDeclNames :: FamilyDecl GhcRn -> [NameOccurrence] -#else -familyDeclNames :: FamilyDecl Name -> [NameOccurrence] -#endif familyDeclNames FamilyDecl {..} = [ NameOccurrence - { locatedName = Just <$> fdLName + { locatedName = Just <$> reLocN fdLName , description = "FamilyDecl" , isBinder = True } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -familyDeclNames _ = [] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) familyEqNames :: FamEqn GhcRn (LHsType GhcRn) -> [NameOccurrence] familyEqNames FamEqn {feqn_tycon = tyCon} = [ NameOccurrence - { locatedName = Just <$> tyCon + { locatedName = Just <$> reLocN tyCon , description = "FamEqn" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -familyEqNames _ = [] -#endif - dataEqNames :: FamEqn GhcRn (HsDataDefn GhcRn) -> [NameOccurrence] dataEqNames FamEqn {feqn_tycon = tyCon} = [ NameOccurrence - { locatedName = Just <$> tyCon + { locatedName = Just <$> reLocN tyCon , description = "FamEqn" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -dataEqNames _ = [] -#endif -#else -tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence] -tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} = - [ NameOccurrence - { locatedName = Just <$> tyCon - , description = "TyFamEqn" - , isBinder = False - } - ] - -tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence] -tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} = - [ NameOccurrence - { locatedName = Just <$> tyCon - , description = "TyFamEqn" - , isBinder = False - } - ] - -dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence] -dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} = - [ NameOccurrence - { locatedName = Just <$> tyCon - , description = "DataFamInstDecl" - , isBinder = False - } - ] -#endif - -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) conDeclNames :: ConDecl GhcRn -> [NameOccurrence] -#else -conDeclNames :: ConDecl Name -> [NameOccurrence] -#endif conDeclNames con = case con of ConDeclGADT {con_names = names} -> map (\n -> NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "ConDeclGADT" , isBinder = True }) names ConDeclH98 {con_name = name} -> [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "ConDeclH98" , isBinder = True } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) - _ -> [] -#endif #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) foreignDeclNames :: ForeignDecl GhcRn -> [NameOccurrence] @@ -616,44 +545,29 @@ foreignDeclNames :: ForeignDecl Name -> [NameOccurrence] #endif foreignDeclNames decl = [ NameOccurrence - { locatedName = Just <$> fd_name decl + { locatedName = Just <$> reLocN (fd_name decl) , description = "ForeignDecl" , isBinder = True } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) roleAnnotationNames :: RoleAnnotDecl GhcRn -> [NameOccurrence] -#else -roleAnnotationNames :: RoleAnnotDecl Name -> [NameOccurrence] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) roleAnnotationNames (RoleAnnotDecl _ n _) = -#else -roleAnnotationNames (RoleAnnotDecl n _) = -#endif [ NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "RoleAnnotDecl" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -roleAnnotationNames _ = [] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) injectivityAnnotationNames :: InjectivityAnn GhcRn -> [NameOccurrence] -#else -injectivityAnnotationNames :: InjectivityAnn Name -> [NameOccurrence] -#endif -injectivityAnnotationNames (InjectivityAnn lhsName rhsNames) = +injectivityAnnotationNames (InjectivityAnn _ lhsName rhsNames) = injAnnNameOcc lhsName : map injAnnNameOcc rhsNames where - injAnnNameOcc :: GenLocated SrcSpan Name -> NameOccurrence + -- injAnnNameOcc :: GenLocated SrcSpan Name -> NameOccurrence injAnnNameOcc n = NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "InjectivityAnn" , isBinder = False } |