cleanup/refactoring

parser-typechecker/src/Unison/Server/Backend.hs

@@ -471,9 +471,9 @@ fixupNamesRelative root = Names3.map0 fixName where
 -- Construct a 'Search' with 'makeTypeSearch' or 'makeTermSearch', and eliminate it with 'applySearch'.
 data Search r = Search
   { lookupNames :: r -> Set (HQ'.HashQualified Name),
-    lookupRelativeHQRefs :: HQ.HashQualified Name -> Set r,
+    lookupRelativeHQRefs' :: HQ'.HashQualified Name -> Set r,
     makeResult :: HQ.HashQualified Name -> r -> Set (HQ.HashQualified Name) -> SR.SearchResult,
-    matchesNamedRef :: Name -> r -> HQ.HashQualified Name -> Bool
+    matchesNamedRef :: Name -> r -> HQ'.HashQualified Name -> Bool
   }
 
 -- | Make a type search, given a short hash length and names to search in.
@@ -481,8 +481,8 @@ makeTypeSearch :: Int -> Names -> Search Reference
 makeTypeSearch len names =
   Search
     { lookupNames = \ref -> Names3.typeName len ref names,
-      lookupRelativeHQRefs = \name -> Names3.lookupRelativeHQType name names,
-      matchesNamedRef = HQ.matchesNamedReference,
+      lookupRelativeHQRefs' = \name -> Names3.lookupRelativeHQType' name names,
+      matchesNamedRef = HQ'.matchesNamedReference,
       makeResult = SR.typeResult
     }
 
@@ -491,16 +491,16 @@ makeTermSearch :: Int -> Names -> Search Referent
 makeTermSearch len names =
   Search
     { lookupNames = \ref -> Names3.termName len ref names,
-      lookupRelativeHQRefs = \name -> Names3.lookupRelativeHQTerm name names,
-      matchesNamedRef = HQ.matchesNamedReferent,
+      lookupRelativeHQRefs' = \name -> Names3.lookupRelativeHQTerm' name names,
+      matchesNamedRef = HQ'.matchesNamedReferent,
       makeResult = SR.termResult
     }
 
 -- | Interpret a 'Search' as a function from name to search results.
-applySearch :: Search r -> HQ.HashQualified Name -> [SR.SearchResult]
-applySearch Search {lookupNames, lookupRelativeHQRefs, makeResult, matchesNamedRef} query =
+applySearch :: Search r -> HQ'.HashQualified Name -> [SR.SearchResult]
+applySearch Search {lookupNames, lookupRelativeHQRefs', makeResult, matchesNamedRef} query =
   -- a bunch of references will match a HQ ref.
-  toList (lookupRelativeHQRefs query) <&> \ref ->
+  toList (lookupRelativeHQRefs' query) <&> \ref ->
     let -- Precondition: the input set is non-empty
         prioritize :: Set (HQ'.HashQualified Name) -> (HQ'.HashQualified Name, Set (HQ'.HashQualified Name))
         prioritize =
@@ -519,14 +519,9 @@ applySearch Search {lookupNames, lookupRelativeHQRefs, makeResult, matchesNamedR
       x : xs -> (x, Set.fromList xs)
 
 -- | The output list (of lists) corresponds to the query list.
-searchBranchExact ::
-  Int -> Names -> [HQ'.HashQualified Name] -> [[SR.SearchResult]]
-searchBranchExact len names queries =
-  -- Mitchell says: the `toHQ` here is a bit odd, and indicates to me the types here are not quite right.
-  -- `searchBranchExact` takes queries that definitely have names (`HashQualified'`), but calls out to a search
-  -- function that is capable of finding refs without names (`Names3.lookupRelativeHQType`). Doesn't it therefore seem
-  -- better to instead accept possibly-nameless `HashQualified` as the input to `searchBranchExact` instead?
-  [applySearch typeSearch q <> applySearch termSearch q | (HQ'.toHQ -> q) <- queries]
+searchBranchExact :: Int -> Names -> [HQ'.HashQualified Name] -> [[SR.SearchResult]]
+searchBranchExact len names queries = do
+  [applySearch typeSearch query <> applySearch termSearch query | query <- queries ]
   where
     typeSearch :: Search Reference
     typeSearch =

unison-core/package.yaml

@@ -38,9 +38,12 @@ default-extensions:
   - FlexibleInstances
   - LambdaCase
   - MultiParamTypeClasses
+  - NamedFieldPuns
+  - PatternSynonyms
   - ScopedTypeVariables
   - TupleSections
   - TypeApplications
+  - ViewPatterns
 
 flags:
   optimized:

unison-core/src/Unison/Names3.hs

@@ -1,7 +1,4 @@
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 module Unison.Names3 where
 
@@ -15,6 +12,7 @@ import qualified Unison.HashQualified' as HQ'
 import Unison.Name (Name)
 import Unison.Reference as Reference
 import Unison.Referent as Referent
+import Unison.ShortHash (ShortHash)
 import Unison.Util.Relation (Relation)
 import qualified Data.Set as Set
 import qualified Data.Map as Map
@@ -127,35 +125,34 @@ shadowing :: Names0 -> Names -> Names
 shadowing prio (Names current old) =
   Names (prio `unionLeftName0` current) (current <> old)
 
-makeAbsolute0:: Names0 -> Names0
+makeAbsolute0 :: Names0 -> Names0
 makeAbsolute0 = map0 Name.makeAbsolute
 
 -- Find all types whose name has a suffix matching the provided `HashQualified`,
 -- returning types with relative names if they exist, and otherwise
 -- returning types with absolute names.
 lookupRelativeHQType :: HashQualified Name -> Names -> Set Reference
-lookupRelativeHQType hq ns@Names{..} = let
-  rs = lookupHQType hq ns
-  keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.types currentNames))
-  in case Set.filter keep rs of
-       rs' | Set.null rs' -> rs
-           | otherwise    -> rs'
+lookupRelativeHQType hq ns@Names {..} =
+  let rs = lookupHQType hq ns
+      keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.types currentNames))
+   in case Set.filter keep rs of
+        rs'
+          | Set.null rs' -> rs
+          | otherwise -> rs'
 
--- Find all types whose name has a suffix matching the provided `HashQualified`.
+lookupRelativeHQType' :: HQ'.HashQualified Name -> Names -> Set Reference
+lookupRelativeHQType' =
+  lookupRelativeHQType . HQ'.toHQ
+
+-- | Find all types whose name has a suffix matching the provided 'HashQualified'.
 lookupHQType :: HashQualified Name -> Names -> Set Reference
-lookupHQType hq Names{..} = case hq of
-  HQ.NameOnly n -> Name.searchBySuffix n (Names.types currentNames)
-  HQ.HashQualified n sh -> case matches sh (Names.types currentNames) of
-    s | (not . null) s -> s
-      | otherwise -> matches sh (Names.types oldNames)
-    where
-    matches sh ns =
-      Set.filter (Reference.isPrefixOf sh) (Name.searchBySuffix n ns)
-  HQ.HashOnly sh -> case matches sh currentNames of
-    s | (not . null) s -> s
-      | otherwise -> matches sh oldNames
-    where
-    matches sh ns = Set.filter (Reference.isPrefixOf sh) (R.ran $ Names.types ns)
+lookupHQType =
+  lookupHQRef Names.types Reference.isPrefixOf
+
+-- | Find all types whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQType'.
+lookupHQType' :: HQ'.HashQualified Name -> Names -> Set Reference
+lookupHQType' =
+  lookupHQType . HQ'.toHQ
 
 hasTermNamed :: Name -> Names -> Bool
 hasTermNamed n ns = not (Set.null $ lookupHQTerm (HQ.NameOnly n) ns)
@@ -167,28 +164,66 @@ hasTypeNamed n ns = not (Set.null $ lookupHQType (HQ.NameOnly n) ns)
 -- returning terms with relative names if they exist, and otherwise
 -- returning terms with absolute names.
 lookupRelativeHQTerm :: HashQualified Name -> Names -> Set Referent
-lookupRelativeHQTerm hq ns@Names{..} = let
-  rs = lookupHQTerm hq ns
-  keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.terms currentNames))
-  in case Set.filter keep rs of
-       rs' | Set.null rs' -> rs
-           | otherwise    -> rs'
+lookupRelativeHQTerm hq ns@Names {..} =
+  let rs = lookupHQTerm hq ns
+      keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.terms currentNames))
+   in case Set.filter keep rs of
+        rs'
+          | Set.null rs' -> rs
+          | otherwise -> rs'
 
--- Find all terms whose name has a suffix matching the provided `HashQualified`.
+lookupRelativeHQTerm' :: HQ'.HashQualified Name -> Names -> Set Referent
+lookupRelativeHQTerm' =
+  lookupRelativeHQTerm . HQ'.toHQ
+
+-- | Find all terms whose name has a suffix matching the provided 'HashQualified'.
+--
+-- If the hash-qualified name does not include a hash, then only current names are searched. Otherwise, old names are
+-- searched, too, if searching current names produces no hits.
 lookupHQTerm :: HashQualified Name -> Names -> Set Referent
-lookupHQTerm hq Names{..} = case hq of
-  HQ.NameOnly n -> Name.searchBySuffix n (Names.terms currentNames)
-  HQ.HashQualified n sh -> case matches sh (Names.terms currentNames) of
-    s | (not . null) s -> s
-      | otherwise -> matches sh (Names.terms oldNames)
-    where
-    matches sh ns =
-      Set.filter (Referent.isPrefixOf sh) (Name.searchBySuffix n ns)
-  HQ.HashOnly sh -> case matches sh currentNames of
-    s | (not . null) s -> s
-      | otherwise -> matches sh oldNames
-    where
-    matches sh ns = Set.filter (Referent.isPrefixOf sh) (R.ran $ Names.terms ns)
+lookupHQTerm =
+  lookupHQRef Names.terms Referent.isPrefixOf
+
+-- | Find all terms whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQTerm'.
+lookupHQTerm' :: HQ'.HashQualified Name -> Names -> Set Referent
+lookupHQTerm' =
+  lookupHQTerm . HQ'.toHQ
+
+-- Helper that unifies looking up a set of references/referents by a hash-qualified suffix.
+--
+-- See 'lookupHQTerm', 'lookupHQType' for monomorphic versions.
+lookupHQRef ::
+  forall r.
+  Ord r =>
+  -- | A projection of types or terms from a Names0.
+  (Names0 -> Relation Name r) ->
+  -- | isPrefixOf, for references or referents
+  (ShortHash -> r -> Bool) ->
+  -- | The name to look up
+  HashQualified Name ->
+  Names ->
+  Set r
+lookupHQRef which isPrefixOf hq Names {currentNames, oldNames} =
+  case hq of
+    HQ.NameOnly n -> Name.searchBySuffix n currentRefs
+    HQ.HashQualified n sh -> matches currentRefs `orIfEmpty` matches oldRefs
+      where
+        matches :: Relation Name r -> Set r
+        matches ns =
+          Set.filter (isPrefixOf sh) (Name.searchBySuffix n ns)
+    HQ.HashOnly sh -> matches currentRefs `orIfEmpty` matches oldRefs
+      where
+        matches :: Relation Name r -> Set r
+        matches ns =
+          Set.filter (isPrefixOf sh) (R.ran ns)
+  where
+    currentRefs = which currentNames
+    oldRefs = which oldNames
+
+    -- (xs `orIfEmpty` ys) returns xs if it's non-empty, otherwise ys
+    orIfEmpty :: Set a -> Set a -> Set a
+    orIfEmpty xs ys =
+      if Set.null xs then ys else xs
 
 -- If `r` is in "current" names, look up each of its names, and hash-qualify
 -- them if they are conflicted names.  If `r` isn't in "current" names, look up

unison-core/unison-core1.cabal

@@ -3,8 +3,6 @@ cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
---
--- hash: 8fff4d6586e59fb0d0aa911caff0a2557bcb58e457a2e485b26d6a908d14ac0d
 
 name:           unison-core1
 version:        0.0.0
@@ -77,9 +75,12 @@ library
       FlexibleInstances
       LambdaCase
       MultiParamTypeClasses
+      NamedFieldPuns
+      PatternSynonyms
       ScopedTypeVariables
       TupleSections
       TypeApplications
+      ViewPatterns
   ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -funbox-strict-fields
   build-depends:
       base