First attempt at allowing wildcard patterns '_' to have a variable na…

…me after, whih is intended to allow documentation of the value that is being ignored: gren-lang#111

compiler/src/Parse/Pattern.hs

@@ -85,15 +85,20 @@ wildcard =
     if pos == end || P.unsafeIndex pos /= 0x5F {- _ -}
       then eerr row col E.PStart
       else
-        let !newPos = plusPtr pos 1
-            !newCol = col + 1
-         in if Var.getInnerWidth newPos end > 0
-              then
-                let (# badPos, badCol #) = Var.chompInnerChars newPos end newCol
-                 in cerr row col (E.PWildcardNotVar (Name.fromPtr pos badPos) (fromIntegral (badCol - col)))
-              else
-                let !newState = P.State src newPos end indent row newCol
-                 in cok () newState
+        let lowerVarPosition = plusPtr pos 1
+            (# newPos, newCol #) = Var.chompLower lowerVarPosition end (col + 1)
+            -- Note although we are getting the name, to check that it is not a reserved keyword, we are not storing it.
+            -- We ultimately wish to throw it away, but in theory we could make the AST of wildcard take the name
+            -- as a parameter, and then we could use that, to, for example, check that we are not shadowing/duplicating any
+            -- such wildcard names, eg. check against something like:
+            -- getZ _x _x z = z
+            -- when you probably meant
+            -- getZ _x _y z = z
+            !name = Name.fromPtr lowerVarPosition newPos
+            !newState = P.State src newPos end indent row newCol
+        in if Var.isReservedWord name 
+           then eerr row col E.PStart
+           else cok () newState
 
 -- PARENTHESIZED PATTERNS
 

compiler/src/Parse/Variable.hs

@@ -11,7 +11,9 @@ module Parse.Variable
     Upper (..),
     foreignUpper,
     foreignAlpha,
+    chompLower,
     chompInnerChars,
+    isReservedWord,
     getUpperWidth,
     getInnerWidth,
     getInnerWidthHelp,
@@ -52,13 +54,17 @@ lower toError =
           then eerr row col toError
           else
             let !name = Name.fromPtr pos newPos
-             in if Set.member name reservedWords
+             in if isReservedWord name 
                   then eerr row col toError
                   else
                     let !newState =
                           P.State src newPos end indent row newCol
                      in cok name newState
 
+isReservedWord :: Name.Name -> Bool
+isReservedWord name =
+    Set.member name reservedWords
+
 reservedWords :: Set.Set Name.Name
 reservedWords =
   Set.fromList

compiler/src/Reporting/Error/Syntax.hs

@@ -331,7 +331,6 @@ data Pattern
   | PNumber Number Row Col
   | PFloat Word16 Row Col
   | PAlias Row Col
-  | PWildcardNotVar Name.Name Int Row Col
   | PSpace Space Row Col
   | --
     PIndentStart Row Col
@@ -5410,40 +5409,6 @@ toPatternReport source context pattern startRow startCol =
                       \ in that case!"
                   ]
               )
-    PWildcardNotVar name width row col ->
-      let region = toWiderRegion row col (fromIntegral width)
-          examples =
-            case dropWhile (== '_') (Name.toChars name) of
-              [] -> [D.dullyellow "x", "or", D.dullyellow "age"]
-              c : cs -> [D.dullyellow (D.fromChars (Char.toLower c : cs))]
-       in Report.Report "UNEXPECTED NAME" region [] $
-            Code.toSnippet source region Nothing $
-              ( D.reflow $
-                  "Variable names cannot start with underscores like this:",
-                D.fillSep $
-                  [ "You",
-                    "can",
-                    "either",
-                    "have",
-                    "an",
-                    "underscore",
-                    "like",
-                    D.dullyellow "_",
-                    "to",
-                    "ignore",
-                    "the",
-                    "value,",
-                    "or",
-                    "you",
-                    "can",
-                    "have",
-                    "a",
-                    "name",
-                    "like"
-                  ]
-                    ++ examples
-                    ++ ["to", "use", "the", "matched", "value."]
-              )
     PSpace space row col ->
       toSpaceReport source space row col
     PIndentStart row col ->

gren.cabal

@@ -243,6 +243,7 @@ Test-Suite gren-tests
         -- tests
         Parse.SpaceSpec
         Parse.RecordUpdateSpec
+        Parse.UnderscorePatternSpec
 
     Build-Depends:
         hspec >= 2.7.10 && < 3

tests/Parse/UnderscorePatternSpec.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Parse.UnderscorePatternSpec where
+
+import AST.Source qualified as Src
+import Data.ByteString qualified as BS
+import Helpers.Instances ()
+import Parse.Pattern qualified as Pattern
+import Parse.Primitives qualified as P
+import Reporting.Annotation qualified as A
+import Test.Hspec ( Spec ) 
+import Test.Hspec qualified as Hspec 
+
+data ParseError
+  = ExprError P.Row P.Col
+  | OtherError String P.Row P.Col
+  deriving (Show, Eq)
+
+spec :: Spec
+spec = do
+  Hspec.describe "Wildcard patterns" $ do
+    Hspec.it "regression test" $
+      parse "_"
+    Hspec.it "Newly allowed named wildcard pattern" $ do
+      parse "_argument"
+    Hspec.it "You can have underscores as part of the lower variable which follows the underscore" $ do
+      parse "_hello_world"
+    Hspec.it "Keywords are not allowed as the whole variable part of an underscore pattern" $ do
+      failToParse "_let"
+    Hspec.it "But you can have a keyword as **part** of a variable name just as for normal variable names." $ do
+      parse "_let_down"
+    Hspec.it "But you cannot start with multiple underscores" $ do
+      failToParse "__hello"
+    Hspec.it "But it must be an lower name, for an underscore pattern" $ do
+      failToParse "_Hello"
+
+attemptParse :: (Either ParseError (Src.Pattern, A.Position) -> Bool) -> BS.ByteString -> IO ()
+attemptParse checkResult str =
+  Hspec.shouldSatisfy
+      ( P.fromByteString
+          (P.specialize (\_ row col -> ExprError row col) Pattern.expression)
+          (OtherError "fromByteString failed")
+          str
+      )
+      checkResult
+
+parse :: BS.ByteString -> IO ()
+parse =
+  let
+    isWildCardPattern :: Either x (Src.Pattern, A.Position) -> Bool
+    isWildCardPattern result =
+      case result of
+        Right (A.At _ Src.PAnything, _) -> True
+        _ -> False
+  in
+  attemptParse isWildCardPattern
+
+
+failToParse :: BS.ByteString -> IO ()
+failToParse =
+  let
+     isError :: Either x (Src.Pattern, A.Position) -> Bool
+     isError result =
+       case result of
+          Left _ ->
+            True
+          _ ->
+            False
+  in
+  attemptParse isError