diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 63bdd69054..86d23c2f75 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -155,11 +155,11 @@ link :: (Monad m, Var v) => TermP v m link = termLink <|> typeLink where typeLink = do - _ <- P.try (reserved "typeLink") -- type opens a block, gotta use something else + _ <- reserved "typeLink" -- type opens a block, gotta use something else tok <- typeLink' pure $ Term.typeLink (ann tok) (L.payload tok) termLink = do - _ <- P.try (reserved "termLink") + _ <- reserved "termLink" tok <- termLink' pure $ Term.termLink (ann tok) (L.payload tok) @@ -191,7 +191,7 @@ match = do scrutinee <- term _ <- optionalCloseBlock _ <- - P.try (openBlockWith "with") <|> do + openBlockWith "with" <|> do t <- anyToken P.customFailure (ExpectedBlockOpen "with" t) (_arities, cases) <- unzip <$> matchCases @@ -225,7 +225,7 @@ matchCase = do _ <- reserved "|" guard <- asum - [ Nothing <$ P.try (quasikeyword "otherwise"), + [ Nothing <$ quasikeyword "otherwise", Just <$> infixAppOrBooleanOp ] (_spanAnn, t) <- layoutBlock "->" @@ -302,7 +302,7 @@ parsePattern = label "pattern" root ctor :: CT.ConstructorType -> P v m (L.Token ConstructorReference) ctor ct = do -- this might be a var, so we avoid consuming it at first - tok <- P.try (P.lookAhead hqPrefixId) + tok <- P.lookAhead hqPrefixId -- First, if: -- @@ -360,7 +360,7 @@ parsePattern = label "pattern" root | Set.null s && (isLower n || isIgnored n) -> fail $ "not a constructor name: " <> show n - -- it was hash qualified and/or uppercase, and wasn't found in the env, that's a failure! + -- it was hash qualified and/or uppercase, and was either not found or ambiguous, that's a failure! _ -> failCommitted $ ResolutionFailures @@ -381,14 +381,10 @@ parsePattern = label "pattern" root ] unzipPatterns f elems = case unzip elems of (patterns, vs) -> f patterns (join vs) - effectBind0 = do + effectBind = do tok <- ctor CT.Effect leaves <- many leaf _ <- reserved "->" - pure (tok, leaves) - - effectBind = do - (tok, leaves) <- P.try effectBind0 (cont, vsp) <- parsePattern pure $ let f patterns vs = (Pattern.EffectBind (ann tok <> ann cont) (L.payload tok) patterns cont, vs ++ vsp) @@ -400,12 +396,37 @@ parsePattern = label "pattern" root effect = do start <- openBlockWith "{" - (inner, vs) <- effectBind <|> effectPure - end <- closeBlock + + -- After the opening curly brace, we are expecting either an EffectBind or an EffectPure: + -- + -- EffectBind EffectPure + -- + -- { foo bar -> baz } { qux } + -- ^^^^^^^^^^^^^^ ^^^ + -- + -- We accomplish that as follows: + -- + -- * First try EffectPure + "}" + -- * If that fails, back the parser up and try EffectBind + "}" instaed + -- + -- This won't always result in the best possible error messages, but it's not exactly trivial to do better, + -- requiring more sophisticated look-ahead logic. So, this is how it works for now. + (inner, vs, end) <- + asum + [ P.try do + (inner, vs) <- effectPure + end <- closeBlock + pure (inner, vs, end), + do + (inner, vs) <- effectBind + end <- closeBlock + pure (inner, vs, end) + ] + pure (Pattern.setLoc inner (ann start <> ann end), vs) -- ex: unique type Day = Mon | Tue | ... - nullaryCtor = P.try do + nullaryCtor = do tok <- ctor CT.Data pure (Pattern.Constructor (ann tok) (L.payload tok) [], []) diff --git a/unison-src/transcripts/fix-5301.md b/unison-src/transcripts/fix-5301.md new file mode 100644 index 0000000000..edffb6ad75 --- /dev/null +++ b/unison-src/transcripts/fix-5301.md @@ -0,0 +1,24 @@ +This transcripts demonstrates that pattern matching on a "constructor" (defined as a variable that begins with a capital +letter) that is either not found or ambiguouus fails. Previously, it would be treated as a variable binding. + +```ucm +scratch/main> builtins.merge +``` + +```unison:error +type Foo = Bar Nat + +foo : Foo -> Nat +foo = cases + Bar X -> 5 +``` + +```unison:error +type Foo = Bar A +type A = X +type B = X + +foo : Foo -> Nat +foo = cases + Bar X -> 5 +``` diff --git a/unison-src/transcripts/fix-5301.output.md b/unison-src/transcripts/fix-5301.output.md new file mode 100644 index 0000000000..9e32c6c16d --- /dev/null +++ b/unison-src/transcripts/fix-5301.output.md @@ -0,0 +1,64 @@ +This transcripts demonstrates that pattern matching on a "constructor" (defined as a variable that begins with a capital +letter) that is either not found or ambiguouus fails. Previously, it would be treated as a variable binding. + +``` ucm +scratch/main> builtins.merge + + Done. + +``` +``` unison +type Foo = Bar Nat + +foo : Foo -> Nat +foo = cases + Bar X -> 5 +``` + +``` ucm + + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 5 | Bar X -> 5 + + + Symbol Suggestions + + X No matches + + +``` +``` unison +type Foo = Bar A +type A = X +type B = X + +foo : Foo -> Nat +foo = cases + Bar X -> 5 +``` + +``` ucm + + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 7 | Bar X -> 5 + + + Symbol Suggestions + + X A.X + B.X + + +``` diff --git a/unison-src/transcripts/pattern-match-coverage.md b/unison-src/transcripts/pattern-match-coverage.md index b4fcce8be8..6b0b248de3 100644 --- a/unison-src/transcripts/pattern-match-coverage.md +++ b/unison-src/transcripts/pattern-match-coverage.md @@ -465,7 +465,7 @@ result : '{e, Give T} r -> {e} r result f = handle !f with cases { x } -> x { give _ -> resume } -> result resume - { give A -> resume } -> result resume + { give T.A -> resume } -> result resume ``` ## Exhaustive ability reinterpretations are accepted diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index b6f48adb3b..6647fb1a37 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -1056,7 +1056,7 @@ result : '{e, Give T} r -> {e} r result f = handle !f with cases { x } -> x { give _ -> resume } -> result resume - { give A -> resume } -> result resume + { give T.A -> resume } -> result resume ``` ``` ucm @@ -1064,7 +1064,7 @@ result f = handle !f with cases Loading changes detected in scratch.u. This case would be ignored because it's already covered by the preceding case(s): - 10 | { give A -> resume } -> result resume + 10 | { give T.A -> resume } -> result resume ```