Merge pull request #5303 from unisonweb/24-08-27-parser-fix

bugfix: not-found or ambiguous constructor treated as var

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) [], [])
 

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
+```

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
+  
+
+```

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

unison-src/transcripts/pattern-match-coverage.output.md

@@ -1056,15 +1056,15 @@ 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
 
   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
     
 
 ```