split up deepTerms/deepTermMetadata

diff0 still todo

parser-typechecker/src/Unison/Codebase/Branch.hs

@@ -73,8 +73,10 @@ data Branch0 m = Branch0
   , _edits :: Map NameSegment (EditHash, m Patch)
   -- names and metadata for this branch and its children
   -- (ref, (name, value)) iff ref has metadata `value` at name `name`
-  , deepTerms :: Metadata.R4 Referent Name
-  , deepTypes :: Metadata.R4 Reference Name
+  , deepTerms :: Relation Referent Name
+  , deepTypes :: Relation Reference Name
+  , deepTermMetadata :: Metadata.R4 Referent Name
+  , deepTypeMetadata :: Metadata.R4 Reference Name
   , deepPaths :: Set Path
   , deepEdits :: Map Name EditHash
   }
@@ -117,8 +119,8 @@ makeLensesFor [("_edits", "edits")] ''Branch0
 makeLenses ''Raw
 
 toNames0 :: Branch0 m -> Names0
-toNames0 b = Names (R.swap . R4.d12 . deepTerms $ b)
-                   (R.swap . R4.d12 . deepTypes $ b)
+toNames0 b = Names (R.swap . deepTerms $ b)
+                   (R.swap . deepTypes $ b)
 
 -- This stops searching for a given ShortHash once it encounters
 -- any term or type in any Branch0 that satisfies that ShortHash.
@@ -166,18 +168,18 @@ findInHistory termMatches typeMatches queries b =
     findQ :: (Set q, Names0) -> q -> (Set q, Names0)
     findQ acc sh =
       foldl' (doType sh) (foldl' (doTerm sh) acc
-                            (R.toList . R4.d12 $ deepTerms b0))
-                            (R.toList . R4.d12 $ deepTypes b0)
+                            (R.toList $ deepTerms b0))
+                            (R.toList $ deepTypes b0)
     doTerm q acc@(remainingSHs, names0) (r, n) = if termMatches q r n
       then (Set.delete q remainingSHs, Names.addTerm n r names0) else acc
     doType q acc@(remainingSHs, names0) (r, n) = if typeMatches q r n
       then (Set.delete q remainingSHs, Names.addType n r names0) else acc
 
 deepReferents :: Branch0 m -> Set Referent
-deepReferents = R4.d1set . deepTerms
+deepReferents = R.dom . deepTerms
 
 deepTypeReferences :: Branch0 m -> Set Reference
-deepTypeReferences = R4.d1set . deepTypes
+deepTypeReferences = R.dom . deepTypes
 
 terms :: Lens' (Branch0 m) (Star Referent NameSegment)
 terms = lens _terms (\Branch0{..} x -> branch0 x _types _children _edits)
@@ -196,19 +198,31 @@ branch0 :: Metadata.Star Referent NameSegment
         -> Branch0 m
 branch0 terms types children edits =
   Branch0 terms types children edits
-          deepTerms' deepTypes' deepPaths' deepEdits'
+          deepTerms' deepTypes'
+          deepTermMetadata' deepTypeMetadata'
+          deepPaths' deepEdits'
   where
   nameSegToName = Name . NameSegment.toText
-  deepTerms' = R4.mapD2 nameSegToName (Metadata.starToR4 terms)
+  deepTerms' = (R.mapRan nameSegToName . Star3.d1) terms
     <> foldMap go (Map.toList children)
    where
     go (nameSegToName -> n, b) =
-      R4.mapD2 (Name.joinDot n) (deepTerms $ head b)
-  deepTypes' = R4.mapD2 nameSegToName (Metadata.starToR4 types)
+      R.mapRan (Name.joinDot n) (deepTerms $ head b) -- could use mapKeysMonotonic
+  deepTypes' = (R.mapRan nameSegToName . Star3.d1) types
     <> foldMap go (Map.toList children)
    where
     go (nameSegToName -> n, b) =
-      R4.mapD2 (Name.joinDot n) (deepTypes $ head b)
+      R.mapRan (Name.joinDot n) (deepTypes $ head b) -- could use mapKeysMonotonic
+  deepTermMetadata' = R4.mapD2 nameSegToName (Metadata.starToR4 terms)
+    <> foldMap go (Map.toList children)
+   where
+    go (nameSegToName -> n, b) =
+      R4.mapD2 (Name.joinDot n) (deepTermMetadata $ head b)
+  deepTypeMetadata' = R4.mapD2 nameSegToName (Metadata.starToR4 types)
+    <> foldMap go (Map.toList children)
+   where
+    go (nameSegToName -> n, b) =
+      R4.mapD2 (Name.joinDot n) (deepTypeMetadata $ head b)
   deepPaths' = Set.map Path.singleton (Map.keysSet children)
     <> foldMap go (Map.toList children)
     where go (nameSeg, b) = Set.map (Path.cons nameSeg) (deepPaths $ head b)
@@ -462,7 +476,8 @@ one :: Branch0 m -> Branch m
 one = Branch . Causal.one
 
 empty0 :: Branch0 m
-empty0 = Branch0 mempty mempty mempty mempty mempty mempty mempty mempty
+empty0 =
+  Branch0 mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty
 
 isEmpty0 :: Branch0 m -> Bool
 isEmpty0 = (== empty0)

parser-typechecker/src/Unison/Codebase/BranchDiff.hs

@@ -3,7 +3,7 @@ module Unison.Codebase.BranchDiff where
 import Data.Map (Map)
 import Data.Set (Set)
 import Unison.Codebase.Branch (Branch0(..))
-import qualified Unison.Codebase.Branch as Branch
+--import qualified Unison.Codebase.Branch as Branch
 import qualified Unison.Codebase.Metadata as Metadata
 import qualified Unison.Codebase.Patch as P
 import qualified Unison.Codebase.TermEdit as TermEdit
@@ -41,14 +41,14 @@ data BranchDiff = BranchDiff
   }
 
 diff0 :: forall m. Monad m => Branch0 m -> Branch0 m -> P.Patch -> BranchDiff
-diff0 old new patch = BranchDiff terms types where
-  (terms, types) =
-    computeSlices
-      (deepr4ToSlice (Branch.deepTerms old))
-      (deepr4ToSlice (Branch.deepTerms new))
-      (deepr4ToSlice (Branch.deepTypes old))
-      (deepr4ToSlice (Branch.deepTypes new))
-      patch
+diff0 _old _new _patch = BranchDiff terms types where
+  (terms, types) = undefined
+--    computeSlices
+--      (deepr4ToSlice (Branch.deepTerms old))
+--      (deepr4ToSlice (Branch.deepTerms new))
+--      (deepr4ToSlice (Branch.deepTypes old))
+--      (deepr4ToSlice (Branch.deepTypes new))
+--      patch
 
 --unpackMetadata :: Branch0 m ->
 

parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs

@@ -483,7 +483,7 @@ loop = do
           else respond $ ShowDiff input (Branch.namesDiff destb merged)
 
       DiffNamespaceI before0 after0 patch0 -> do
-        let [beforep, afterp] = 
+        let [beforep, afterp] =
               Path.toAbsolutePath currentPath' <$> [before0, after0]
         before <- Branch.head <$> getAt beforep
         after <- Branch.head <$> getAt afterp
@@ -878,8 +878,8 @@ loop = do
               1 -> HQ'.fromName ns
               _ -> HQ'.take hashLen $ HQ'.fromNamedReference ns r
           defnCount b =
-            (R4.size . deepTerms $ Branch.head b) +
-            (R4.size . deepTypes $ Branch.head b)
+            (R.size . deepTerms $ Branch.head b) +
+            (R.size . deepTypes $ Branch.head b)
           patchCount b = (length . deepEdits $ Branch.head b)
 
         termEntries <- for (R.toList . Star3.d1 $ _terms b0) $
@@ -1178,7 +1178,7 @@ loop = do
       TestI showOk showFail -> do
         let
           testTerms = Map.keys . R4.d1 . (uncurry R4.selectD34) isTest
-                    . Branch.deepTerms $ currentBranch0
+                    . Branch.deepTermMetadata $ currentBranch0
           testRefs = Set.fromList [ r | Referent.Ref r <- toList testTerms ]
           oks results =
             [ (r, msg)

parser-typechecker/src/Unison/Codebase/Metadata.hs

@@ -23,9 +23,8 @@ type Metadata = Map Type (Set Value)
 -- `Type` is the type of metadata. Duplicate info to speed up certain queries.
 -- `(Type, Value)` is the metadata value itself along with its type.
 type Star a n = Star3 a n Type (Type, Value)
-type R4 a n = R4.Relation4 a n Type Value 
+type R4 a n = R4.Relation4 a n Type Value
 
--- starToR4 not needed if https://github.com/unisonweb/unison/issues/1060
 starToR4 :: (Ord r, Ord n) => Star r n -> Relation4 r n Type Value
 starToR4 = R4.fromList . fmap (\(r,n,_,(t,v)) -> (r,n,t,v)) . Star3.toList
 

parser-typechecker/src/Unison/Util/Star3.hs

@@ -10,13 +10,14 @@ import qualified Unison.Hashable as H
 import qualified Unison.Util.Relation as R
 
 -- Represents a set of (fact, d1, d2, d3), but indexed using a star schema so
--- it can be efficiently quried from any of the dimensions.
+-- it can be efficiently queried from any of the dimensions.
 data Star3 fact d1 d2 d3
   = Star3 { fact :: Set fact
           , d1 :: Relation fact d1
           , d2 :: Relation fact d2
           , d3 :: Relation fact d3 } deriving (Eq,Ord,Show)
 
+-- use this function, lol
 toList :: (Ord fact, Ord d1, Ord d2, Ord d3)
        => Star3 fact d1 d2 d3
        -> [(fact, d1, d2, d3)]

unison-core/src/Unison/Util/Relation3.hs

@@ -28,24 +28,31 @@ toList :: Relation3 a b c -> [(a,b,c)]
 toList = fmap (\(a,(b,c)) -> (a,b,c)) . toNestedList
 
 toNestedList :: Relation3 a b c -> [(a,(b,c))]
-toNestedList r3 = 
+toNestedList r3 =
   [ (a,bc) | (a,r2) <- Map.toList $ d1 r3
-           , bc <- R.toList r2 ] 
+           , bc <- R.toList r2 ]
 
 insert, delete
   :: (Ord a, Ord b, Ord c)
   => a -> b -> c -> Relation3 a b c -> Relation3 a b c
 insert a b c Relation3{..} =
   Relation3
-    (Map.update (Just . R.insert b c) a d1)
-    (Map.update (Just . R.insert a c) b d2)
-    (Map.update (Just . R.insert a b) c d3)
+    (Map.alter (ins b c) a d1)
+    (Map.alter (ins a c) b d2)
+    (Map.alter (ins a b) c d3)
+  where
+    ins x y = Just . R.insert x y . fromMaybe mempty
 
 delete a b c Relation3{..} =
   Relation3
-    (Map.update (Just . R.delete b c) a d1)
-    (Map.update (Just . R.delete a c) b d2)
-    (Map.update (Just . R.delete a b) c d3)
+    (Map.alter (del b c) a d1)
+    (Map.alter (del a c) b d2)
+    (Map.alter (del a b) c d3)
+  where
+    del _ _ Nothing = Nothing
+    del x y (Just r) =
+      let r' = R.delete x y r
+      in if r' == mempty then Nothing else Just r'
 
 instance (Ord a, Ord b, Ord c) => Semigroup (Relation3 a b c) where
   (<>) = mappend

unison-core/src/Unison/Util/Relation4.hs

@@ -23,6 +23,9 @@ data Relation4 a b c d
   , d4 :: Map d (Relation3 a b c)
   } deriving (Eq,Ord)
 
+instance (Show a, Show b, Show c, Show d) => Show (Relation4 a b c d) where
+  show = show . toList
+
 size :: (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d -> Int
 size = getSum . foldMap (Sum . R3.size) . d1
 
@@ -44,18 +47,18 @@ fromList xs = insertAll xs empty
 filter :: (Ord a, Ord b, Ord c, Ord d) => ((a,b,c,d) -> Bool) -> Relation4 a b c d -> Relation4 a b c d
 filter f = fromList . Prelude.filter f . toList
 
-selectD3 :: (Ord a, Ord b, Ord c, Ord d) 
+selectD3 :: (Ord a, Ord b, Ord c, Ord d)
   => c -> Relation4 a b c d -> Relation4 a b c d
-selectD3 c r = 
-  fromList [ (a,b,c,d) | (a,b,d) <- maybe [] R3.toList $ Map.lookup c (d3 r) ] 
+selectD3 c r =
+  fromList [ (a,b,c,d) | (a,b,d) <- maybe [] R3.toList $ Map.lookup c (d3 r) ]
 
-selectD34 :: (Ord a, Ord b, Ord c, Ord d) 
+selectD34 :: (Ord a, Ord b, Ord c, Ord d)
   => c -> d -> Relation4 a b c d -> Relation4 a b c d
-selectD34 c d r = 
-  fromList [ (a,b,c,d) 
-           | (a,b) <- maybe [] (maybe [] R.toList . Map.lookup d . R3.d3) 
+selectD34 c d r =
+  fromList [ (a,b,c,d)
+           | (a,b) <- maybe [] (maybe [] R.toList . Map.lookup d . R3.d3)
                                (Map.lookup c (d3 r))
-           ] 
+           ]
 
 d1set :: Ord a => Relation4 a b c d -> Set a
 d1set = Map.keysSet . d1
@@ -76,17 +79,24 @@ insert, delete
   => a -> b -> c -> d -> Relation4 a b c d -> Relation4 a b c d
 insert a b c d Relation4{..} =
   Relation4
-    (Map.update (Just . R3.insert b c d) a d1)
-    (Map.update (Just . R3.insert a c d) b d2)
-    (Map.update (Just . R3.insert a b d) c d3)
-    (Map.update (Just . R3.insert a b c) d d4)
+    (Map.alter (ins b c d) a d1)
+    (Map.alter (ins a c d) b d2)
+    (Map.alter (ins a b d) c d3)
+    (Map.alter (ins a b c) d d4)
+  where
+    ins x y z = Just . R3.insert x y z . fromMaybe mempty
 
 delete a b c d Relation4{..} =
   Relation4
-    (Map.update (Just . R3.delete b c d) a d1)
-    (Map.update (Just . R3.delete a c d) b d2)
-    (Map.update (Just . R3.delete a b d) c d3)
-    (Map.update (Just . R3.delete a b c) d d4)
+    (Map.alter (del b c d) a d1)
+    (Map.alter (del a c d) b d2)
+    (Map.alter (del a b d) c d3)
+    (Map.alter (del a b c) d d4)
+  where
+    del _ _ _ Nothing = Nothing
+    del x y z (Just r) =
+      let r' = R3.delete x y z r
+      in if r' == mempty then Nothing else Just r'
 
 mapD2 :: (Ord a, Ord b, Ord b', Ord c, Ord d)
       => (b -> b') -> Relation4 a b c d -> Relation4 a b' c d