unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-23 08:18:04 +03:00
Code Issues Projects Releases Wiki Activity

wip

Browse Source
This commit is contained in:
runarorama 2021-02-17 22:36:20 -05:00
parent 92cbf1ceb8
commit fbf4bade3e
1 changed files with 50 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
parser-typechecker/src/Unison/Server/Backend.hs
View File

@ -161,50 +161,58 @@ findShallow
-> Backend m [ShallowListEntry v Ann] -> Backend m [ShallowListEntry v Ann]
findShallow codebase path' = do findShallow codebase path' = do
let path = Path.unabsolute path' let path = Path.unabsolute path'
hashLength <- lift $ Codebase.hashLength codebase
root <- getRootBranch codebase root <- getRootBranch codebase
let mayb0 = Branch.head <$> Branch.getAt path root let mayb = Branch.getAt path root
case mayb0 of case mayb of
Nothing -> pure [] Nothing -> pure []
Just b0 -> do Just b -> findShallowInBranch codebase b
let hqTerm b0 ns r =
let refs = Star3.lookupD1 ns . Branch._terms $ b0 findShallowInBranch
in case length refs of :: (Monad m, Var v)
1 -> HQ'.fromName ns => Codebase m v Ann
_ -> HQ'.take hashLength $ HQ'.fromNamedReferent ns r -> Branch m
hqType b0 ns r = -> Backend m [ShallowListEntry v Ann]
let refs = Star3.lookupD1 ns . Branch._types $ b0 findShallowInBranch codebase b = do
in case length refs of hashLength <- lift $ Codebase.hashLength codebase
1 -> HQ'.fromName ns let hqTerm b0 ns r =
_ -> HQ'.take hashLength $ HQ'.fromNamedReference ns r let refs = Star3.lookupD1 ns . Branch._terms $ b0
defnCount b = in case length refs of
(R.size . Branch.deepTerms $ Branch.head b) 1 -> HQ'.fromName ns
+ (R.size . Branch.deepTypes $ Branch.head b) _ -> HQ'.take hashLength $ HQ'.fromNamedReferent ns r
termEntries <- for (R.toList . Star3.d1 $ Branch._terms b0) $ \(r, ns) -> hqType b0 ns r =
do let refs = Star3.lookupD1 ns . Branch._types $ b0
ot <- lift $ loadReferentType codebase r in case length refs of
pure $ ShallowTermEntry r (hqTerm b0 ns r) ot 1 -> HQ'.fromName ns
let _ -> HQ'.take hashLength $ HQ'.fromNamedReference ns r
typeEntries = defnCount b =
[ ShallowTypeEntry r (hqType b0 ns r) (R.size . Branch.deepTerms $ Branch.head b)
| (r, ns) <- R.toList . Star3.d1 $ Branch._types b0 + (R.size . Branch.deepTypes $ Branch.head b)
] b0 = Branch.head b
branchEntries = termEntries <- for (R.toList . Star3.d1 $ Branch._terms b0) $ \(r, ns) -> do
[ ShallowBranchEntry ns ot <- lift $ loadReferentType codebase r
(SBH.fullFromHash $ Branch.headHash b) pure $ ShallowTermEntry r (hqTerm b0 ns r) ot
(defnCount b) let
| (ns, b) <- Map.toList $ Branch._children b0 typeEntries =
] [ ShallowTypeEntry r (hqType b0 ns r)
patchEntries = | (r, ns) <- R.toList . Star3.d1 $ Branch._types b0
[ ShallowPatchEntry ns ]
| (ns, (_h, _mp)) <- Map.toList $ Branch._edits b0 branchEntries =
] [ ShallowBranchEntry ns
pure (SBH.fullFromHash $ Branch.headHash b)
. List.sortOn listEntryName (defnCount b)
$ termEntries | (ns, b) <- Map.toList $ Branch._children b0
++ typeEntries ]
++ branchEntries patchEntries =
++ patchEntries [ ShallowPatchEntry ns
| (ns, (_h, _mp)) <- Map.toList $ Branch._edits b0
]
pure
. List.sortOn listEntryName
$ termEntries
++ typeEntries
++ branchEntries
++ patchEntries
termReferencesByShortHash termReferencesByShortHash
:: Monad m => Codebase m v a -> ShortHash -> m (Set Reference) :: Monad m => Codebase m v a -> ShortHash -> m (Set Reference)