diff options
| author | alexwl <alexey.a.kiryushin@gmail.com> | 2018-11-09 19:37:55 +0300 |
|---|---|---|
| committer | alexwl <alexey.a.kiryushin@gmail.com> | 2018-11-11 16:58:35 +0300 |
| commit | d4827af4220c934739e4ee3b26caab32e591d8ed (patch) | |
| tree | 4b0260238e690229ec67c597ab10ec5f7f86d30e /src | |
| parent | a3b2321f7781c98c2863a54a339af73a6d6d0050 (diff) | |
Fix pattern synonym declarations
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaskellCodeExplorer/GhcUtils.hs | 4 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/ModuleInfo.hs | 20 |
2 files changed, 16 insertions, 8 deletions
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs index b25678d..33370d5 100644 --- a/src/HaskellCodeExplorer/GhcUtils.hs +++ b/src/HaskellCodeExplorer/GhcUtils.hs @@ -172,7 +172,7 @@ import Name , isSystemName , isTvNameSpace , isTyConName - , isVarNameSpace + , isValNameSpace , isWiredInName , mkInternalName , mkOccName @@ -360,9 +360,9 @@ nameSort n = occNameNameSpace :: OccName -> HCE.NameSpace occNameNameSpace n - | isVarNameSpace (occNameSpace n) = HCE.VarName | isDataConNameSpace (occNameSpace n) = HCE.DataName | isTvNameSpace (occNameSpace n) = HCE.TvName + | isValNameSpace (occNameSpace n) = HCE.VarName | otherwise = HCE.TcClsName -- Two 'Id''s may have different types even though they have the same 'Unique'. diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs index ddd7e9f..e908af2 100644 --- a/src/HaskellCodeExplorer/ModuleInfo.hs +++ b/src/HaskellCodeExplorer/ModuleInfo.hs @@ -660,7 +660,7 @@ addIdentifierToMaps environment idSrcSpanMap idMaps@(idInfoMap, idOccMap) nameOc nameOcc = case nameOcc of TyLitOccurrence {kind = kind} -> - addTypeToMaps + addNameToMaps environment idMaps (Just kind) @@ -707,11 +707,11 @@ addIdentifierToMaps environment idSrcSpanMap idMaps@(idInfoMap, idOccMap) nameOc [((startCol, endCol), idOcc)] idOccMap in (idInfoMap', idOccMap') - Nothing -- type variable + Nothing -- type variable or an internal identifier in a pattern synonym -> case unLoc $ locatedName nameOcc of Just name -> - addTypeToMaps + addNameToMaps environment idMaps Nothing @@ -723,7 +723,7 @@ addIdentifierToMaps environment idSrcSpanMap idMaps@(idInfoMap, idOccMap) nameOc Nothing -> idMaps addIdentifierToMaps _ _ idMaps _ = idMaps -addTypeToMaps :: +addNameToMaps :: Environment -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap) -> Maybe Type @@ -733,7 +733,7 @@ addTypeToMaps :: -> Int -> Int -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap) -addTypeToMaps environment (idInfoMap, idOccMap) mbKind mbName descr lineNumber colStart colEnd = +addNameToMaps environment (idInfoMap, idOccMap) mbKind mbName descr lineNumber colStart colEnd = let flags = envDynFlags environment idInfoMap' = maybe @@ -754,7 +754,15 @@ addTypeToMaps environment (idInfoMap, idOccMap) mbKind mbName descr lineNumber c , idOccType = mkType flags <$> mbKind , typeArguments = Nothing , description = descr - , sort = HCE.TypeId + , sort = + maybe + HCE.TypeId + (\name -> + case occNameNameSpace . nameOccName $ name of + HCE.VarName -> HCE.ValueId + HCE.DataName -> HCE.ValueId + _ -> HCE.TypeId) + mbName } idOccMap' = IM.insertWith |