Skip to content

Commit

Permalink
stub out typechecking step
Browse files Browse the repository at this point in the history
  • Loading branch information
Arya Irani committed Oct 10, 2023
1 parent 32faa94 commit 8bb1eab
Show file tree
Hide file tree
Showing 2 changed files with 84 additions and 57 deletions.
23 changes: 21 additions & 2 deletions unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,7 @@ import Unison.Sqlite (Transaction)
import Unison.Sqlite qualified as Sqlite
import Unison.Syntax.Name qualified as Name (toText)
import Unison.Term qualified as V1 (Term)
import Unison.UnisonFile.Type (TypecheckedUnisonFile (TypecheckedUnisonFileId))
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Map qualified as Map
Expand Down Expand Up @@ -173,10 +174,28 @@ handleMerge alicePath0 bobPath0 _resultPath = do
-- If there are no conflicts, then proceed to typechecking
if (null conflictedTerms && null conflictedTypes)
then do
wundefined
let typecheck = wundefined
loadTerm = Codebase.unsafeGetTerm codebase
loadDecl = Codebase.unsafeGetTypeDeclaration codebase
namelookup :: Merge.RefToName = wundefined
aliceNames :: Merge.DeepRefs = wundefined
bobNames :: Merge.DeepRefs = wundefined
aliceUpdates :: Merge.UpdatesRefnt = wundefined
bobUpdates :: Merge.UpdatesRefnt = wundefined
combinedUpdates :: Merge.UpdatesRefnt = wundefined
whatToTypecheck :: Merge.WhatToTypecheck <- Merge.whatToTypecheck (aliceNames, aliceUpdates) (bobNames, bobUpdates)
unisonfile <- Merge.computeUnisonFile namelookup loadTerm loadDecl whatToTypecheck combinedUpdates
typecheck unisonfile >>= \case
Just tuf@(TypecheckedUnisonFileId {}) -> do
let saveToCodebase = wundefined
let consAndSaveNamespace = wundefined
saveToCodebase tuf
consAndSaveNamespace tuf
Nothing -> wundefined "dump to scratch file"
else do
-- If there are conflicts, then create a MergeOutput
wundefined
mergeOutput <- wundefined "create MergeOutput"
wundefined "dump MergeOutput to scratchfile" mergeOutput

let mergedLibdeps =
Merge.mergeLibdeps
Expand Down
118 changes: 63 additions & 55 deletions unison-merge/src/Unison/Merge2.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,17 @@ module Unison.Merge2
nameBasedNamespaceDiff,

-- * Typechecking
WhatToTypecheck (..),
whatToTypecheck,
computeUnisonFile,

-- * Misc / organize these later
UpdatesRefnt (..),
DiffOp (..),
Updates (..),
DeepRefsId' (..),
DeepRefs (..),
-- DeepRefsId' (..),
RefToName (..),
Defns (..),
DefnsA,
DefnsB,
Expand Down Expand Up @@ -472,6 +476,7 @@ instance Monoid RefsToSubst where
-- Q: Does this return all of the updates? A: suspect no currently
newtype WhatToTypecheck = WhatToTypecheck {unWhatToTypecheck :: DeepRefsId'}

-- Question: What should these input types be?
-- drAlice and drBob could be `DeepRefs` because that's what the diff gives us,
-- or they could be `DeepRefsId` because they're also the set of possibilities for typechecking, and we wouldn't be needing to typecheck any builtins
-- it CAN'T be `DeepRefsId` because they're also the set of dependencies for looking up dependents, and if someone replaced a term with a ctor,
Expand All @@ -480,6 +485,8 @@ newtype WhatToTypecheck = WhatToTypecheck {unWhatToTypecheck :: DeepRefsId'}
-- Hypothesis: This implementation would be much simpler if we had a richer dependency lookup.
-- As it stands, we can't look up the dependents of a constructor or pattern; we instead look up the dependents of the decl they came from (which is weird?)
-- Similarly, when we ask "which <thing we can look up can lookup dependents for> is named <x>", and we want to look up constructors, that's weird.
-- - term replaced with ctor: look up dependents of term in the opposing branch (ok)
-- - ctor replaced with term: look up dependents of ctor in the opposing branch (we'll look up dependents of the decl instead, getting excess results, but it's ok)

-- Question: What happens if I update a ctor?
whatToTypecheck :: (DeepRefs, UpdatesRefnt) -> (DeepRefs, UpdatesRefnt) -> Transaction WhatToTypecheck
Expand Down Expand Up @@ -570,59 +577,60 @@ type Pretty = Text

type Defn v a = Either (V1.Term v a) (V1.Decl v a) -- could also be a builtin alias

pseudoOutput :: (Name -> Defn v a -> Pretty) -> MergeOutput v a -> Pretty
pseudoOutput printDefn merge = prettyConflicts <> newline <> prettyTransitiveDeps
where
(conflicted, transitiveDeps) = foldl' partitionConflicts mempty (terms $ definitions merge)
partitionConflicts (conflicted, transitiveDeps) (name, cog) = case cog of
Left conflict -> (Map.insert name conflict conflicted, transitiveDeps)
Right unconflicted -> (conflicted, Map.insert name unconflicted transitiveDeps)
prettyTransitiveDeps = foldMap prettyTransitiveDep (Map.toList transitiveDeps)
prettyTransitiveDep = uncurry printDefn
prettyConflicts = foldMap prettyConflict (Map.toList conflicted)
prettyConflict = \case
(name, ConflictAddAdd b1 b2 d1 d2) ->
mintercalate
"\n"
[ "-- added in " <> b1,
printDefn name d1,
"-- added in " <> b2,
printDefn name d2
]
(name, ConflictUpdateUpdate b1 b2 d1 d2) ->
mintercalate
"\n"
[ "-- updated in " <> b1,
printDefn name d1,
"-- updated in " <> b2,
printDefn name d2
]
(name, ConflictDeleteAddDependent b1 b2 d) ->
mintercalate
"\n"
[ "-- deleted in " <> b1,
printDeletedDefn name d,
"-- original definition still in use by " <> b2,
printDefn name d
]
(name, ConflictDeleteUpdate b1 b2 d1 d2) ->
mintercalate
"\n"
[ "-- deleted in " <> b1,
printDefn name d1,
"-- updated in " <> b2,
printDefn name d2
]
printDeletedDefn :: Name -> Defn v a -> Pretty
printDeletedDefn name = \case
_term@Left {} -> Name.toText name <> " = " <> "<<<deleted>>>"
Right (Left (V1.EffectDeclaration _effect)) -> case V1.Decl.modifier _effect of
V1.Decl.Structural -> "structural ability " <> Name.toText name <> " where " <> "<<<deleted>>>"
V1.Decl.Unique {} -> "unique ability " <> Name.toText name <> " where " <> "<<<deleted>>>"
(Right (Right _data)) -> case V1.Decl.modifier _data of
V1.Decl.Structural -> "structural type " <> Name.toText name <> " = " <> "<<<>>>"
V1.Decl.Unique {} -> "unique type " <> Name.toText name <> " = " <> "<<<>>>"
newline = "\n"
-- pseudoOutput :: (Name -> Defn v a -> Pretty) -> MergeOutput v a -> Pretty
-- pseudoOutput printDefn merge = prettyConflicts <> newline <> prettyTransitiveDeps
-- where
-- (conflicted, transitiveDeps) = foldl' partitionConflicts mempty (_terms $ definitions merge)
-- -- partitionConflicts :: (Map k a, Map k a1) -> (k, Either a a1) -> (Map k a, Map k a1)
-- partitionConflicts (conflicted, transitiveDeps) (name, cog) = case cog of
-- Left conflict -> (Map.insert name conflict conflicted, transitiveDeps)
-- Right unconflicted -> (conflicted, Map.insert name unconflicted transitiveDeps)
-- prettyTransitiveDeps = foldMap prettyTransitiveDep (Map.toList transitiveDeps)
-- prettyTransitiveDep = uncurry printDefn
-- prettyConflicts = foldMap prettyConflict (Map.toList conflicted)
-- prettyConflict = \case
-- (name, ConflictAddAdd b1 b2 d1 d2) ->
-- mintercalate
-- "\n"
-- [ "-- added in " <> b1,
-- printDefn name d1,
-- "-- added in " <> b2,
-- printDefn name d2
-- ]
-- (name, ConflictUpdateUpdate b1 b2 d1 d2) ->
-- mintercalate
-- "\n"
-- [ "-- updated in " <> b1,
-- printDefn name d1,
-- "-- updated in " <> b2,
-- printDefn name d2
-- ]
-- (name, ConflictDeleteAddDependent b1 b2 d) ->
-- mintercalate
-- "\n"
-- [ "-- deleted in " <> b1,
-- printDeletedDefn name d,
-- "-- original definition still in use by " <> b2,
-- printDefn name d
-- ]
-- (name, ConflictDeleteUpdate b1 b2 d1 d2) ->
-- mintercalate
-- "\n"
-- [ "-- deleted in " <> b1,
-- printDefn name d1,
-- "-- updated in " <> b2,
-- printDefn name d2
-- ]
-- printDeletedDefn :: Name -> Defn v a -> Pretty
-- printDeletedDefn name = \case
-- _term@Left {} -> Name.toText name <> " = " <> "<<<deleted>>>"
-- Right (Left (V1.EffectDeclaration _effect)) -> case V1.Decl.modifier _effect of
-- V1.Decl.Structural -> "structural ability " <> Name.toText name <> " where " <> "<<<deleted>>>"
-- V1.Decl.Unique {} -> "unique ability " <> Name.toText name <> " where " <> "<<<deleted>>>"
-- (Right (Right _data)) -> case V1.Decl.modifier _data of
-- V1.Decl.Structural -> "structural type " <> Name.toText name <> " = " <> "<<<>>>"
-- V1.Decl.Unique {} -> "unique type " <> Name.toText name <> " = " <> "<<<>>>"
-- newline = "\n"

mintercalate :: Monoid a => a -> [a] -> a
mintercalate x ys = x <> go ys
Expand All @@ -639,7 +647,7 @@ sintercalate x ys = go $ toList ys

type BranchName = Text

type ConflictOrGood a = Either (Conflict BranchName a) a
data ConflictOrGood a = Conflict (Conflict BranchName a) | Good a

data Conflict branch a
= ConflictAddAdd !branch !branch !a !a
Expand Down

0 comments on commit 8bb1eab

Please sign in to comment.