Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

remove metadata types from the in-memory branches #4714

Merged
merged 2 commits into from
Feb 26, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,6 @@ v2ToH2Branch V2.Branch {terms, types, patches, children} = do
v2ToH2MdValues :: V2Branch.MdValues -> H2.MdValues
v2ToH2MdValues (V2Branch.MdValues mdMap) =
mdMap
& Map.keysSet
& Set.map v2ToH2Reference
& H2.MdValues

Expand Down
28 changes: 3 additions & 25 deletions codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs
Original file line number Diff line number Diff line change
Expand Up @@ -215,11 +215,6 @@ import Unison.Util.Set qualified as Set
debug :: Bool
debug = False

newtype NeedTypeForBuiltinMetadata
= NeedTypeForBuiltinMetadata Text
deriving stock (Show)
deriving anyclass (SqliteExceptionReason)

-- * Database lookups

objectExistsForHash :: H.Hash -> Transaction Bool
Expand Down Expand Up @@ -558,20 +553,6 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
<*> doPatches patches
<*> doChildren children
where
loadMetadataType :: S.Reference -> Transaction C.Reference
loadMetadataType = \case
C.ReferenceBuiltin tId ->
Q.expectTextCheck tId (Left . NeedTypeForBuiltinMetadata)
C.ReferenceDerived id ->
typeReferenceForTerm id >>= h2cReference

loadTypesForMetadata :: Set S.Reference -> Transaction (Map C.Reference C.Reference)
loadTypesForMetadata rs =
Map.fromList
<$> traverse
(\r -> (,) <$> s2cReference r <*> loadMetadataType r)
(Foldable.toList rs)

doTerms ::
Map Db.TextId (Map S.Referent S.DbMetadataSet) ->
Transaction (Map NameSegment (Map C.Referent (Transaction C.Branch.MdValues)))
Expand All @@ -580,7 +561,7 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
(fmap NameSegment . Q.expectText)
( Map.bitraverse s2cReferent \case
S.MetadataSet.Inline rs ->
pure $ C.Branch.MdValues <$> loadTypesForMetadata rs
pure $ C.Branch.MdValues <$> Set.traverse s2cReference rs
)
doTypes ::
Map Db.TextId (Map S.Reference S.DbMetadataSet) ->
Expand All @@ -590,7 +571,7 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
(fmap NameSegment . Q.expectText)
( Map.bitraverse s2cReference \case
S.MetadataSet.Inline rs ->
pure $ C.Branch.MdValues <$> loadTypesForMetadata rs
pure $ C.Branch.MdValues <$> Set.traverse s2cReference rs
)
doPatches ::
Map Db.TextId Db.PatchObjectId ->
Expand Down Expand Up @@ -732,7 +713,7 @@ saveNamespace hh bhId me = do
c2sMetadata :: Transaction C.Branch.MdValues -> Transaction S.Branch.Full.DbMetadataSet
c2sMetadata mm = do
C.Branch.MdValues m <- mm
S.Branch.Full.Inline <$> Set.traverse c2sReference (Map.keysSet m)
S.Branch.Full.Inline <$> Set.traverse c2sReference m

savePatchObjectId :: (PatchHash, Transaction C.Branch.Patch) -> Transaction Db.PatchObjectId
savePatchObjectId (h, mp) = do
Expand Down Expand Up @@ -1068,9 +1049,6 @@ filterTermsByReferentHavingType cTypeRef cTermRefIds =
matches <- Q.filterTermsByReferentHavingType sTypeRef sTermRefIds
traverse s2cReferentId matches

typeReferenceForTerm :: S.Reference.Id -> Transaction S.ReferenceH
typeReferenceForTerm = Q.getTypeReferenceForReferent . C.Referent.RefId

termsMentioningType :: C.Reference -> Transaction (Set C.Referent.Id)
termsMentioningType cTypeRef =
runMaybeT (c2hReference cTypeRef) >>= \case
Expand Down
2 changes: 1 addition & 1 deletion codebase2/codebase/U/Codebase/Branch/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ type MetadataType = Reference

type MetadataValue = Reference

newtype MdValues = MdValues {unMdValues :: Map MetadataValue MetadataType} deriving (Eq, Ord, Show)
newtype MdValues = MdValues {unMdValues :: Set MetadataValue} deriving (Eq, Ord, Show)

type CausalBranch m = Causal m CausalHash BranchHash (Branch m) (Branch m)

Expand Down
6 changes: 3 additions & 3 deletions parser-typechecker/src/Unison/Codebase/Metadata.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,15 +9,15 @@ where

import Data.Map qualified as Map
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Reference (TermReference)
import Unison.Util.List qualified as List
import Unison.Util.Relation qualified as R
import Unison.Util.Star3 (Star3)
import Unison.Util.Star3 qualified as Star3

type Type = Reference
type Type = () -- dummy value, intermediate phase of removing metadata altogether
Copy link
Contributor

@ChrisPenner ChrisPenner Feb 23, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm a little confused, what's the purpose of keeping a dummy type here? Is this being used anywhere that we can't also just delete?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think we'd need to write a Star2 type and drop the Type index here. It would be better, but it just felt like busywork that was already slated to be thrown out.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I got nerdsniped

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

an hour later and no end in sight... it doesn't help that HLS lied about what's safe to delete, when it hadn't loaded all the packages yet to know.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Alternative at https://github.com/unisonweb/unison/compare/topic/NeedTypeForBuiltinMetadata-more
I agree it is better, but in retrospect also agree with past self that it's hard to justify the time expenditure when it's going to be tossed anyway.


type Value = Reference
type Value = TermReference

-- `a` is generally the type of references or hashes
-- `n` is generally the the type of name associated with the references
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -440,8 +440,9 @@ causalbranch1to2 (V1.Branch.Branch c) =
Map.fromList
[ (referent1to2 r, pure md)
| r <- toList . Relation.lookupRan ns $ V1.Star3.d1 s,
let mdrefs1to2 (typeR1, valR1) = (reference1to2 valR1, reference1to2 typeR1)
md = V2.Branch.MdValues . Map.fromList . map mdrefs1to2 . toList . Relation.lookupDom r $ V1.Star3.d3 s
-- throwing away the metadata type reference here as we are trying to phase out metadata completely
let mdrefs1to2 (_typeR1, valR1) = reference1to2 valR1
md = V2.Branch.MdValues . Set.map mdrefs1to2 . Relation.lookupDom r $ V1.Star3.d3 s
]
]

Expand All @@ -454,8 +455,9 @@ causalbranch1to2 (V1.Branch.Branch c) =
Map.fromList
[ (reference1to2 r, pure md)
| r <- toList . Relation.lookupRan ns $ V1.Star3.d1 s,
let mdrefs1to2 (typeR1, valR1) = (reference1to2 valR1, reference1to2 typeR1)
md = V2.Branch.MdValues . Map.fromList . map mdrefs1to2 . toList . Relation.lookupDom r $ V1.Star3.d3 s
-- throwing away the metadata type reference here as we are trying to phase out metadata completely
let mdrefs1to2 (_typeR1, valR1) = reference1to2 valR1
md = V2.Branch.MdValues . Set.map mdrefs1to2 . Relation.lookupDom r $ V1.Star3.d3 s
]
]

Expand Down Expand Up @@ -530,9 +532,9 @@ branch2to1 branchCache lookupCT (V2.Branch.Branch v2terms v2types v2patches v2ch
let facts = Set.singleton ref
names = Relation.singleton ref name
types :: Relation.Relation ref V1.Metadata.Type =
Relation.insertManyRan ref (fmap mdref2to1 (Map.elems mdvals)) mempty
Relation.insertManyRan ref (fmap (const ()) (Set.toList mdvals)) mempty
vals :: Relation.Relation ref (V1.Metadata.Type, V1.Metadata.Value) =
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could this just be Relation.Relation ref V1.Metadata.Value now?

Relation.insertManyRan ref (fmap (\(v, t) -> (mdref2to1 t, mdref2to1 v)) (Map.toList mdvals)) mempty
Relation.insertManyRan ref (fmap (\v -> ((), mdref2to1 v)) (Set.toList mdvals)) mempty
in star <> V1.Star3.Star3 facts names types vals

-- | Generates a v1 short hash from a v2 referent.
Expand Down
4 changes: 2 additions & 2 deletions parser-typechecker/tests/Unison/Test/Codebase/Branch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,15 +31,15 @@ branch0Tests =
b0 :: Branch0 Identity =
Branch.branch0
mempty
(Star3.fromList [(dummy, "b", dummy, (dummy, dummy))])
(Star3.fromList [(dummy, "b", (), ((), dummy))])
Map.empty
Map.empty
let -- a.b
-- b
b1 :: Branch0 Identity =
Branch.branch0
mempty
(Star3.fromList [(dummy, "b", dummy, (dummy, dummy))])
(Star3.fromList [(dummy, "b", (), ((), dummy))])
(Map.singleton "a" (Branch (Causal.one b0)))
Map.empty

Expand Down
13 changes: 5 additions & 8 deletions unison-cli/src/Unison/Codebase/Editor/Propagate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -603,10 +603,9 @@ applyDeprecations patch =
-- definition that is created by the `Edits` which is passed in is marked as
-- a propagated change.
applyPropagate :: forall m. (Applicative m) => Patch -> Edits Symbol -> Branch0 m -> Branch0 m
applyPropagate patch Edits {newTerms, termReplacements, typeReplacements, constructorReplacements} = do
let termTypes = Map.map (Hashing.typeToReference . snd) newTerms
applyPropagate patch Edits {termReplacements, typeReplacements, constructorReplacements} = do
-- recursively update names and delete deprecated definitions
stepEverywhereButLib (updateLevel termReplacements typeReplacements termTypes)
stepEverywhereButLib (updateLevel termReplacements typeReplacements)
where
-- Like Branch.stepEverywhere, but don't step the child named "lib"
stepEverywhereButLib :: (Branch0 m -> Branch0 m) -> (Branch0 m -> Branch0 m)
Expand All @@ -619,15 +618,14 @@ applyPropagate patch Edits {newTerms, termReplacements, typeReplacements, constr
isPropagated r = Set.notMember r allPatchTargets
allPatchTargets = Patch.allReferenceTargets patch
propagatedMd :: forall r. r -> (r, Metadata.Type, Metadata.Value)
propagatedMd r = (r, IOSource.isPropagatedReference, IOSource.isPropagatedValue)
propagatedMd r = (r, (), IOSource.isPropagatedValue)

updateLevel ::
Map Referent Referent ->
Map Reference Reference ->
Map Reference Reference ->
Branch0 m ->
Branch0 m
updateLevel termEdits typeEdits termTypes Branch0 {..} =
updateLevel termEdits typeEdits Branch0 {..} =
Branch.branch0 terms types _children _edits
where
isPropagatedReferent (Referent.Con _ _) = True
Expand All @@ -651,9 +649,8 @@ applyPropagate patch Edits {newTerms, termReplacements, typeReplacements, constr
updateMetadatas s = Star3.mapD3 go s
where
go (tp, v) = case Map.lookup (Referent.Ref v) termEdits of
Just (Referent.Ref r) -> (typeOf r tp, r)
Just (Referent.Ref r) -> ((), r)
_ -> (tp, v)
typeOf r t = fromMaybe t $ Map.lookup r termTypes

replaceTerm :: Referent -> Referent -> Metadata.Star Referent NameSegment -> Metadata.Star Referent NameSegment
replaceTerm _r r' s =
Expand Down
Loading