fix parsing of constructor patterns with args without parens

ElaraLang · May 5, 2024 · aadac49 · aadac49
1 parent 517a2b0
commit aadac49
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 15 deletions.
diff --git a/src/Elara/Data/TopologicalGraph.hs b/src/Elara/Data/TopologicalGraph.hs
@@ -9,7 +9,6 @@ import Data.Containers.ListUtils (nubOrd)
 import Data.Graph
 import Elara.Data.Pretty
 import Elara.Utils (uncurry3)
-import Print (debugPretty)
 import Relude.Extra (firstF)
 import Text.Show qualified as Show
 

diff --git a/src/Elara/Parse/Pattern.hs b/src/Elara/Parse/Pattern.hs
@@ -15,16 +15,13 @@ patParser :: Parser FrontendPattern
 patParser =
     choice
         [ try literalPattern
-        , inParens apat
+        , inParens rpat
         , varPattern
-        , zeroArgConstructorPattern
+        , constructorPattern
         , wildcardPattern
         , listPattern
         ]
 
-apat :: Parser FrontendPattern
-apat = constructorPattern <|> rpat
-
 rpat :: Parser FrontendPattern
 rpat =
     makeExprParser
@@ -68,12 +65,6 @@ listPattern = locatedPattern $ do
 
 --     pure $ ConsPattern head' tail'
 
--- To prevent ambiguity between space-separated patterns and constructor patterns
-zeroArgConstructorPattern :: Parser FrontendPattern
-zeroArgConstructorPattern = locatedPattern $ do
-    con <- located conName
-    pure $ ConstructorPattern con []
-
 constructorPattern :: Parser FrontendPattern
 constructorPattern = locatedPattern $ do
     con <- located conName

diff --git a/test/Arbitrary/AST.hs b/test/Arbitrary/AST.hs
@@ -34,7 +34,9 @@ genPattern =
         ]
         [ Gen.subterm2 genPattern genPattern (\x y -> mkPat (ConsPattern x y))
         , mkPat . ListPattern <$> Gen.list (Range.linear 0 5) genPattern
-        , (\x y -> mkPat (ConstructorPattern x y)) <$> genMaybeQualified genTypeName <*> Gen.list (Range.linear 0 5) genPattern
+        , (\x y -> mkPat (ConstructorPattern x y))
+            <$> genMaybeQualified genTypeName
+            <*> Gen.list (Range.linear 0 5) genPattern
         ]
 
 genBinaryOperator :: Gen (BinaryOperator 'UnlocatedFrontend)

diff --git a/test/Parse/Patterns.hs b/test/Parse/Patterns.hs
@@ -91,8 +91,14 @@ constructorPatterns = describe "Parses constructor parens" $ do
     it "Parses constructor patterns correctly" $ hedgehog $ do
         "ZeroArity" `shouldParsePattern` Pattern (ConstructorPattern "ZeroArity" [], Nothing)
 
-    it "Fails with multiple arguments without parens" $ hedgehog $ do
-        shouldFailToParse "TwoArgs 1 2"
+    it "Parses single constructor pattern without parens" $ hedgehog $ do
+        "TwoArgs 1 2"
+            `shouldParsePattern` Pattern
+                ( ConstructorPattern
+                    "TwoArgs"
+                    [Pattern (IntegerPattern 1, Nothing), Pattern (IntegerPattern 2, Nothing)]
+                , Nothing
+                )
 
     it "Parses constructor patterns with parens correctly" $ hedgehog $ do
         "(TwoArgs one two)"