mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-23 08:18:04 +03:00
Merge pull request #1642 from unisonweb/fix/1640
Fix #1640 caused by incorrect parsing of nested patterns that mention nullary constructors
This commit is contained in:
commit
0fa8c725dc
@ -144,10 +144,10 @@ matchCase = do
|
||||
pure . Term.MatchCase p (fmap (absChain boundVars') guard) $ absChain boundVars' t
|
||||
|
||||
parsePattern :: forall v. Var v => P v (Pattern Ann, [(Ann, v)])
|
||||
parsePattern =
|
||||
chainl1 patternCandidates patternInfixApp
|
||||
parsePattern = root
|
||||
where
|
||||
patternCandidates = constructor <|> seqLiteral <|> leaf
|
||||
root = chainl1 patternCandidates patternInfixApp
|
||||
patternCandidates = constructor <|> leaf
|
||||
patternInfixApp :: P v ((Pattern Ann, [(Ann, v)])
|
||||
-> (Pattern Ann, [(Ann, v)])
|
||||
-> (Pattern Ann, [(Ann, v)]))
|
||||
@ -156,7 +156,11 @@ parsePattern =
|
||||
f op (l, lvs) (r, rvs) =
|
||||
(Pattern.SequenceOp (ann l <> ann r) l op r, lvs ++ rvs)
|
||||
|
||||
leaf = literal <|> varOrAs <|> unbound <|>
|
||||
-- note: nullaryCtor comes before var patterns, since (for better or worse)
|
||||
-- they can overlap (a variable could be called 'Foo' in the current grammar).
|
||||
-- This order treats ambiguous patterns as nullary constructors if there's
|
||||
-- a constructor with a matching name.
|
||||
leaf = literal <|> nullaryCtor <|> varOrAs <|> unbound <|> seqLiteral <|>
|
||||
parenthesizedOrTuplePattern <|> effect
|
||||
literal = (,[]) <$> asum [true, false, number, text, char]
|
||||
true = (\t -> Pattern.Boolean (ann t) True) <$> reserved "true"
|
||||
@ -225,15 +229,21 @@ parsePattern =
|
||||
end <- closeBlock
|
||||
pure (Pattern.setLoc inner (ann start <> ann end), vs)
|
||||
|
||||
-- ex: unique type Day = Mon | Tue | ...
|
||||
nullaryCtor = P.try $ do
|
||||
tok <- ctor UnknownAbilityConstructor
|
||||
let (ref, cid) = L.payload tok
|
||||
pure (Pattern.Constructor (ann tok) ref cid [], [])
|
||||
|
||||
constructor = do
|
||||
tok <- ctor UnknownDataConstructor
|
||||
let (ref,cid) = L.payload tok
|
||||
f patterns vs =
|
||||
let loc = foldl (<>) (ann tok) $ map ann patterns
|
||||
in (Pattern.Constructor loc ref cid patterns, vs)
|
||||
unzipPatterns f <$> many patternCandidates
|
||||
unzipPatterns f <$> many leaf
|
||||
|
||||
seqLiteral = Parser.seq f leaf
|
||||
seqLiteral = Parser.seq f root
|
||||
where f loc = unzipPatterns ((,) . Pattern.SequenceLiteral loc)
|
||||
|
||||
lam :: Var v => TermP v -> TermP v
|
||||
|
25
unison-src/tests/fix1640.u
Normal file
25
unison-src/tests/fix1640.u
Normal file
@ -0,0 +1,25 @@
|
||||
|
||||
unique type Color = Red | Black
|
||||
unique type RBTree a = Leaf | Tree Color (RBTree a) a (RBTree a)
|
||||
|
||||
-- interesting, this typechecks fine
|
||||
isRed = cases
|
||||
Color.Red -> true
|
||||
Color.Black -> false
|
||||
|
||||
-- as does this
|
||||
RBTree.isRed1 = cases
|
||||
RBTree.Tree _ _ _ _ -> true
|
||||
_ -> false
|
||||
|
||||
-- but this did not (before this fix)
|
||||
RBTree.isRed = cases
|
||||
RBTree.Tree Color.Red _ _ _ -> true
|
||||
_ -> false
|
||||
|
||||
-- In fixing this bug, I noticed that the parser would previously reject
|
||||
-- this perfectly cromulent pattern match, so I fixed that too.
|
||||
thisIsTotallyLegit = cases
|
||||
[RBTree.Tree _ _ _ _] -> true
|
||||
_ -> false
|
||||
|
Loading…
Reference in New Issue
Block a user