Merge pull request #4322 from unisonweb/cp/accessor-dependencies

parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs

@@ -0,0 +1,115 @@
+module Unison.DataDeclaration.Dependencies
+  ( -- Too many variants of decl dependencies. Read carefully to choose the right one.
+    DD.declTypeDependencies,
+    DD.typeDependencies,
+    DD.labeledTypeDependencies,
+    DD.labeledDeclTypeDependencies,
+    DD.labeledDeclDependenciesIncludingSelf,
+    labeledDeclDependenciesIncludingSelfAndFieldAccessors,
+    fieldAccessorRefs,
+    hashFieldAccessors,
+  )
+where
+
+import Control.Lens
+import Data.Map qualified as Map
+import Data.Set qualified as Set
+import Data.Set.Lens (setOf)
+import U.Codebase.Reference qualified as V2Reference
+import Unison.DataDeclaration qualified as DD
+import Unison.Hashing.V2.Convert qualified as Hashing
+import Unison.LabeledDependency qualified as LD
+import Unison.Prelude
+import Unison.PrettyPrintEnv (PrettyPrintEnv)
+import Unison.PrettyPrintEnv qualified as PPE
+import Unison.Reference (Reference)
+import Unison.Reference qualified as Reference
+import Unison.Referent (Referent)
+import Unison.Referent qualified as Referent
+import Unison.Result qualified as Result
+import Unison.Term qualified as Term
+import Unison.Type qualified as Type
+import Unison.Typechecker qualified as Typechecker
+import Unison.Typechecker.TypeLookup (TypeLookup (..))
+import Unison.Typechecker.TypeLookup qualified as TypeLookup
+import Unison.Var qualified as Var
+
+-- | Generate the LabeledDependencies for everything in a Decl, including the Decl itself, all
+-- its constructors, all referenced types, and all possible record accessors.
+--
+-- Note that we can't actually tell whether the Decl was originally a record or not, so we
+-- include all possible accessors, but they may or may not exist in the codebase.
+labeledDeclDependenciesIncludingSelfAndFieldAccessors :: Var.Var v => V2Reference.TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency
+labeledDeclDependenciesIncludingSelfAndFieldAccessors selfRef decl =
+  DD.labeledDeclDependenciesIncludingSelf selfRef decl
+    <> case decl of
+      Left _effect -> mempty
+      Right dataDecl ->
+        fieldAccessorRefs selfRef dataDecl
+          & maybe Set.empty (Set.map LD.TermReferent)
+
+-- | Generate Referents for all possible field accessors of a Decl.
+-- Returns 'Nothing' if typechecking of any accessor fails.
+fieldAccessorRefs :: forall v a. (Var.Var v) => Reference -> DD.DataDeclaration v a -> Maybe (Set Referent)
+fieldAccessorRefs declRef dd = do
+  -- This ppe is only used for typechecking errors.
+  let ppe = PPE.empty
+  typ <- case DD.constructors dd of
+    [(_, typ)] -> Just typ
+    _ -> Nothing
+  -- This name isn't important, we just need a name to generate field names from.
+  -- The field names are thrown away afterwards.
+  let typeName = Var.named "Type"
+  -- These names are arbitrary and don't show up anywhere.
+  let vars :: [v]
+      vars = [Var.freshenId (fromIntegral n) (Var.named "_") | n <- [0 .. Type.arity typ - 1]]
+  hashFieldAccessors ppe typeName vars declRef dd
+    <&> \accs ->
+      Map.elems accs
+        & setOf (folded . _1 . to (Reference.DerivedId >>> Referent.Ref))
+
+-- | Generate Referents for all possible field accessors of a Decl.
+-- Returns 'Nothing' if typechecking of any accessor fails (which shouldn't happen).
+hashFieldAccessors ::
+  forall v a.
+  (Var.Var v) =>
+  PrettyPrintEnv ->
+  v ->
+  [v] ->
+  Reference ->
+  DD.DataDeclaration v a ->
+  ( Maybe
+      (Map v (Reference.Id, Term.Term v (), Type.Type v ()))
+  )
+hashFieldAccessors ppe declName vars declRef dd = do
+  let accessors :: [(v, (), Term.Term v ())]
+      accessors = DD.generateRecordAccessors (map (,()) vars) declName declRef
+  let typeLookup :: TypeLookup v ()
+      typeLookup =
+        TypeLookup
+          { TypeLookup.typeOfTerms = mempty,
+            TypeLookup.dataDecls = Map.singleton declRef (void dd),
+            TypeLookup.effectDecls = mempty
+          }
+  let typecheckingEnv :: Typechecker.Env v ()
+      typecheckingEnv =
+        Typechecker.Env
+          { Typechecker._ambientAbilities = mempty,
+            Typechecker._typeLookup = typeLookup,
+            Typechecker._termsByShortname = mempty
+          }
+  accessorsWithTypes :: [(v, Term.Term v (), Type.Type v ())] <-
+    for accessors \(v, _a, trm) ->
+      case Result.result (Typechecker.synthesize ppe Typechecker.PatternMatchCoverageCheckSwitch'Disabled typecheckingEnv trm) of
+        Nothing -> Nothing
+        -- Note: Typechecker.synthesize doesn't normalize the output
+        -- type. We do so here using `Type.cleanup`, mirroring what's
+        -- done when typechecking a whole file and ensuring we get the
+        -- same inferred type.
+        Just typ -> Just (v, trm, Type.cleanup typ)
+  pure $
+    accessorsWithTypes
+      & fmap (\(v, trm, typ) -> (v, (trm, typ, ())))
+      & Map.fromList
+      & Hashing.hashTermComponents
+      & fmap (\(id, trm, typ, _a) -> (id, trm, typ))

parser-typechecker/src/Unison/Syntax/DeclPrinter.hs

@@ -10,26 +10,20 @@ import Unison.DataDeclaration
     toDataDecl,
   )
 import Unison.DataDeclaration qualified as DD
+import Unison.DataDeclaration.Dependencies qualified as DD
 import Unison.HashQualified qualified as HQ
-import Unison.Hashing.V2.Convert qualified as Hashing
 import Unison.Name (Name)
-import Unison.Prelude
 import Unison.PrettyPrintEnv (PrettyPrintEnv)
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
 import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.Reference (Reference, Reference' (DerivedId))
 import Unison.Referent qualified as Referent
-import Unison.Result qualified as Result
 import Unison.Syntax.HashQualified qualified as HQ (toString, toVar, unsafeFromString)
 import Unison.Syntax.NamePrinter (styleHashQualified'')
 import Unison.Syntax.TypePrinter (runPretty)
 import Unison.Syntax.TypePrinter qualified as TypePrinter
-import Unison.Term qualified as Term
 import Unison.Type qualified as Type
-import Unison.Typechecker qualified as Typechecker
-import Unison.Typechecker.TypeLookup (TypeLookup (TypeLookup))
-import Unison.Typechecker.TypeLookup qualified as TypeLookup
 import Unison.Util.Pretty (Pretty)
 import Unison.Util.Pretty qualified as P
 import Unison.Util.SyntaxText qualified as S
@@ -160,35 +154,10 @@ fieldNames env r name dd = do
     _ -> Nothing
   let vars :: [v]
       vars = [Var.freshenId (fromIntegral n) (Var.named "_") | n <- [0 .. Type.arity typ - 1]]
-  let accessors :: [(v, (), Term.Term v ())]
-      accessors = DD.generateRecordAccessors (map (,()) vars) (HQ.toVar name) r
-  let typeLookup :: TypeLookup v ()
-      typeLookup =
-        TypeLookup
-          { TypeLookup.typeOfTerms = mempty,
-            TypeLookup.dataDecls = Map.singleton r (void dd),
-            TypeLookup.effectDecls = mempty
-          }
-  let typecheckingEnv :: Typechecker.Env v ()
-      typecheckingEnv =
-        Typechecker.Env
-          { Typechecker._ambientAbilities = mempty,
-            Typechecker._typeLookup = typeLookup,
-            Typechecker._termsByShortname = mempty
-          }
-  accessorsWithTypes :: [(v, Term.Term v (), Type.Type v ())] <-
-    for accessors \(v, _a, trm) ->
-      case Result.result (Typechecker.synthesize env Typechecker.PatternMatchCoverageCheckSwitch'Disabled typecheckingEnv trm) of
-        Nothing -> Nothing
-        -- Note: Typechecker.synthesize doesn't normalize the output
-        -- type. We do so here using `Type.cleanup`, mirroring what's
-        -- done when typechecking a whole file and ensuring we get the
-        -- same inferred type.
-        Just typ -> Just (v, trm, Type.cleanup typ)
-  let hashes = Hashing.hashTermComponents (Map.fromList . fmap (\(v, trm, typ) -> (v, (trm, typ, ()))) $ accessorsWithTypes)
+  hashes <- DD.hashFieldAccessors env (HQ.toVar name) vars r dd
   let names =
         [ (r, HQ.toString . PPE.termName env . Referent.Ref $ DerivedId r)
-          | r <- (\(refId, _trm, _typ, _ann) -> refId) <$> Map.elems hashes
+          | r <- (\(refId, _trm, _typ) -> refId) <$> Map.elems hashes
         ]
   let fieldNames =
         Map.fromList
@@ -200,7 +169,7 @@ fieldNames env r name dd = do
       Just
         [ HQ.unsafeFromString name
           | v <- vars,
-            Just (ref, _, _, _) <- [Map.lookup (Var.namespaced [HQ.toVar name, v]) hashes],
+            Just (ref, _, _) <- [Map.lookup (Var.namespaced [HQ.toVar name, v]) hashes],
             Just name <- [Map.lookup ref fieldNames]
         ]
     else Nothing

parser-typechecker/unison-parser-typechecker.cabal

@@ -93,6 +93,7 @@ library
       Unison.Codebase.UniqueTypeGuidLookup
       Unison.Codebase.Verbosity
       Unison.CodebasePath
+      Unison.DataDeclaration.Dependencies
       Unison.FileParsers
       Unison.Hashing.V2.Convert
       Unison.Parsers

unison-core/src/Unison/DataDeclaration.hs

@@ -78,6 +78,10 @@ labeledDeclTypeDependencies = Set.map LD.TypeReference . declTypeDependencies
 
 -- | Compute the dependencies of a data declaration,
 -- including the type itself and references for each of its constructors.
+--
+-- NOTE: You may prefer labeledDeclDependenciesIncludingSelfAndFieldAccessors in
+-- Unison.DataDeclaration.Dependencies, it also includes Referents for accessors of record
+-- fields.
 labeledDeclDependenciesIncludingSelf :: (Ord v) => Reference.TypeReference -> Decl v a -> Set LD.LabeledDependency
 labeledDeclDependenciesIncludingSelf selfRef decl =
   labeledDeclTypeDependencies decl <> (Set.singleton $ LD.TypeReference selfRef) <> labeledConstructorRefs
@@ -274,8 +278,10 @@ bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constru
   pure $ DataDeclaration m a bound constructors
 
 -- | All references to types mentioned in the given data declaration's fields/constructors
--- Note: does not include references to the constructors or the decl itself
+-- Note: Does not include references to the constructors or the decl itself
 -- (unless the decl is self-referential)
+-- Note: Does NOT include the referents for fields and field accessors.
+-- Those must be computed separately because we need access to the typechecker to do so.
 typeDependencies :: (Ord v) => DataDeclaration v a -> Set Reference
 typeDependencies dd =
   Set.unions (Type.dependencies <$> constructorTypes dd)

unison-share-api/src/Unison/Server/Backend.hs

@@ -140,6 +140,7 @@ import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.ConstructorReference qualified as ConstructorReference
 import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration qualified as DD
+import Unison.DataDeclaration.Dependencies qualified as DD
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
 import Unison.Hashing.V2.Convert qualified as Hashing
@@ -834,7 +835,7 @@ definitionResultsDependencies (DefinitionResults {termResults, typeResults}) =
       typeDeps =
         typeResults
           & ifoldMap \typeRef ddObj ->
-            foldMap (DD.labeledDeclDependenciesIncludingSelf typeRef) ddObj
+            foldMap (DD.labeledDeclDependenciesIncludingSelfAndFieldAccessors typeRef) ddObj
    in termDeps <> typeDeps <> topLevelTerms <> topLevelTypes
 
 expandShortCausalHash :: ShortCausalHash -> Backend Sqlite.Transaction CausalHash