From 46d4c5f6f82d3eb4ec62727767157f53bc13ac38 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <hi@ypei.me>
Date: Fri, 3 Jun 2022 00:37:17 +1000
Subject: renamed source done
---
src/HaskellCodeExplorer/AST/RenamedSource.hs | 198 ++++++++-------------------
1 file changed, 56 insertions(+), 142 deletions(-)
(limited to 'src/HaskellCodeExplorer/AST')
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
}
--
cgit v1.2.3