Skip to content

Commit

Permalink
clean some code up and fix pattern-match-coverage.md
Browse files Browse the repository at this point in the history
  • Loading branch information
mitchellwrosen committed Aug 27, 2024
1 parent 01d3454 commit 24a6c9b
Show file tree
Hide file tree
Showing 10 changed files with 24 additions and 105 deletions.
1 change: 0 additions & 1 deletion parser-typechecker/src/Unison/Syntax/FileParser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@ import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Prelude
Expand Down
5 changes: 2 additions & 3 deletions parser-typechecker/src/Unison/Syntax/TermParser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -344,12 +344,11 @@ parsePattern = label "pattern" root
names <- asks names
case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of
s
| Set.null s -> die names tok s
| Set.size s > 1 -> die names tok s
| otherwise -> do
| Set.size s == 1 -> do
-- matched ctor name, consume the token
_ <- anyToken
pure (Set.findMin s <$ tok)
| otherwise -> die names tok s
where
isLower = Text.all Char.isLower . Text.take 1 . Name.toText
isIgnored n = Text.take 1 (Name.toText n) == "_"
Expand Down
2 changes: 1 addition & 1 deletion parser-typechecker/src/Unison/UnisonFile/Names.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,8 @@ import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.Names qualified as DD.Names
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.Names (Names (..))
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.NamesWithHistory qualified as Names
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
Expand Down
2 changes: 1 addition & 1 deletion unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ import Unison.Codebase.Editor.Slurp qualified as Slurp
import Unison.Codebase.Runtime qualified as Runtime
import Unison.FileParsers qualified as FileParsers
import Unison.Names (Names)
import Unison.NamesWithHistory qualified as Names (shadowing)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Parsers qualified as Parsers
Expand Down
4 changes: 2 additions & 2 deletions unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs
Original file line number Diff line number Diff line change
Expand Up @@ -334,7 +334,7 @@ makePPE hashLen names initialFileNames dependents =
-- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be
-- ambiguous in the context of namespace + file names.
--
-- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the
-- So, we use `shadowing`, which starts with the LHS names (the namespace), and adds to it names from the
-- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS.
(PPE.suffixifyByHash (Names.unionLeftName names initialFileNames))
(PPE.suffixifyByHash (Names.shadowing names initialFileNames))
)
1 change: 0 additions & 1 deletion unison-core/src/Unison/Name.hs
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,6 @@ import Unison.Prelude
import Unison.Util.Alphabetical (Alphabetical, compareAlphabetical)
import Unison.Util.List qualified as List
import Unison.Util.Relation qualified as R
import qualified Data.Text as Text

-- | @compareSuffix x y@ compares the suffix of @y@ (in reverse segment order) that is as long as @x@ to @x@ (in reverse
-- segment order).
Expand Down
84 changes: 9 additions & 75 deletions unison-core/src/Unison/Names.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,9 +38,7 @@ module Unison.Names
typeReferences,
termsNamed,
typesNamed,
unionLeft,
unionLeftName,
unionLeftRef,
shadowing,
namesForReference,
namesForReferent,
shadowTerms,
Expand Down Expand Up @@ -205,79 +203,15 @@ restrictReferences refs Names {..} = Names terms' types'
terms' = R.filterRan ((`Set.member` refs) . Referent.toReference) terms
types' = R.filterRan (`Set.member` refs) types

-- | Guide to unionLeft*
-- Is it ok to create new aliases for parsing?
-- Sure.
--
-- Is it ok to create name conflicts for parsing?
-- It's okay but not great. The user will have to hash-qualify to disambiguate.
--
-- Is it ok to create new aliases for pretty-printing?
-- Not helpful, we need to choose a name to show.
-- We'll just have to choose one at random if there are aliases.
-- Is it ok to create name conflicts for pretty-printing?
-- Still okay but not great. The pretty-printer will have to hash-qualify
-- to disambiguate.
--
-- Thus, for parsing:
-- unionLeftName is good if the name `n` on the left is the only `n` the
-- user will want to reference. It allows the rhs to add aliases.
-- unionLeftRef allows new conflicts but no new aliases. Lame?
-- (<>) is ok for parsing if we expect to add some conflicted names,
-- e.g. from history
--
-- For pretty-printing:
-- Probably don't want to add new aliases, unless we don't know which
-- `Names` is higher priority. So if we do have a preferred `Names`,
-- don't use `unionLeftName` or (<>).
-- You don't want to create new conflicts either if you have a preferred
-- `Names`. So in this case, don't use `unionLeftRef` either.
-- I guess that leaves `unionLeft`.
--
-- Not sure if the above is helpful or correct!

-- unionLeft two Names, including new aliases, but excluding new name conflicts.
-- e.g. unionLeftName [foo -> #a, bar -> #a, cat -> #c]
-- [foo -> #b, baz -> #c]
-- = [foo -> #a, bar -> #a, baz -> #c, cat -> #c)]
-- Btw, it's ok to create name conflicts for parsing environments, if you don't
-- mind disambiguating.
unionLeftName :: Names -> Names -> Names
unionLeftName = unionLeft' $ const . R.memberDom

-- unionLeft two Names, including new name conflicts, but excluding new aliases.
-- e.g. unionLeftRef [foo -> #a, bar -> #a, cat -> #c]
-- [foo -> #b, baz -> #c]
-- = [foo -> #a, bar -> #a, foo -> #b, cat -> #c]
unionLeftRef :: Names -> Names -> Names
unionLeftRef (Names priorityTerms priorityTypes) (Names fallbackTerms fallbackTypes) =
Names (restricter priorityTerms fallbackTerms) (restricter priorityTypes fallbackTypes)
where
restricter priorityRel fallbackRel =
let refsExclusiveToFallback = (Relation.ran fallbackRel) `Set.difference` (Relation.ran priorityRel)
in priorityRel <> Relation.restrictRan fallbackRel refsExclusiveToFallback

-- unionLeft two Names, but don't create new aliases or new name conflicts.
-- e.g. unionLeft [foo -> #a, bar -> #a, cat -> #c]
-- [foo -> #b, baz -> #c]
-- = [foo -> #a, bar -> #a, cat -> #c]
unionLeft :: Names -> Names -> Names
unionLeft = unionLeft' go
where
go n r acc = R.memberDom n acc || R.memberRan r acc

-- implementation detail of the above
unionLeft' ::
(forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool) ->
Names ->
Names ->
Names
unionLeft' shouldOmit a b = Names terms' types'
-- | Prefer names in the first argument, falling back to names in the second.
-- This can be used to shadow names in the codebase with names in a unison file for instance:
-- e.g. @shadowing scratchFileNames codebaseNames@
shadowing :: Names -> Names -> Names
shadowing a b =
Names (shadowing a.terms b.terms) (shadowing a.types b.types)
where
terms' = foldl' go a.terms (R.toList b.terms)
types' = foldl' go a.types (R.toList b.types)
go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b
go acc (n, r) = if shouldOmit n r acc then acc else R.insert n r acc
shadowing xs ys =
Relation.fromMultimap (Map.unionWith (\x _ -> x) (Relation.domain xs) (Relation.domain ys))

-- | TODO: get this from database. For now it's a constant.
numHashChars :: Int
Expand Down
7 changes: 0 additions & 7 deletions unison-core/src/Unison/NamesWithHistory.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@
module Unison.NamesWithHistory
( diff,
push,
shadowing,
lookupHQType,
lookupHQType',
lookupHQTerm,
Expand Down Expand Up @@ -104,12 +103,6 @@ push n0 ns = unionLeft0 n1 ns
uniqueTerms = [(n, ref) | (n, nubOrd -> [ref]) <- Map.toList terms']
uniqueTypes = [(n, ref) | (n, nubOrd -> [ref]) <- Map.toList types']

-- | Prefer names in the first argument, falling back to names in the second.
-- This can be used to shadow names in the codebase with names in a unison file for instance:
-- e.g. @shadowing scratchFileNames codebaseNames@
shadowing :: Names -> Names -> Names
shadowing = Names.unionLeftName

-- 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.
Expand Down
2 changes: 1 addition & 1 deletion unison-src/transcripts/pattern-match-coverage.md
Original file line number Diff line number Diff line change
Expand Up @@ -434,7 +434,7 @@ unique type T = A | B
result : '{e, Give T} r -> {e} r
result f = handle !f with cases
{ x } -> x
{ give A -> resume } -> result resume
{ give T.A -> resume } -> result resume
```

```unison:error
Expand Down
21 changes: 8 additions & 13 deletions unison-src/transcripts/pattern-match-coverage.output.md
Original file line number Diff line number Diff line change
Expand Up @@ -997,26 +997,21 @@ unique type T = A | B
result : '{e, Give T} r -> {e} r
result f = handle !f with cases
{ x } -> x
{ give A -> resume } -> result resume
{ give T.A -> resume } -> result resume
```

``` ucm
Loading changes detected in scratch.u.
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
ability Give a
result : '{e, Give T} r ->{e} r
⍟ These names already exist. You can `update` them to your
new definition:
Pattern match doesn't cover all possible cases:
7 | result f = handle !f with cases
8 | { x } -> x
9 | { give T.A -> resume } -> result resume
type T
Patterns not matched:
* { give B -> _ }
```
``` unison
Expand Down

0 comments on commit 24a6c9b

Please sign in to comment.