From 860ca4f04957e7f0d439a4176a4ee35f42dbe633 Mon Sep 17 00:00:00 2001 From: allanderek Date: Thu, 1 Sep 2022 18:39:08 +0000 Subject: [PATCH] First attempt at allowing wildcard patterns '_' to have a variable name after, whih is intended to allow documentation of the value that is being ignored: https://github.com/gren-lang/compiler/issues/111 --- compiler/src/Parse/Pattern.hs | 23 +++++---- compiler/src/Parse/Variable.hs | 8 ++- compiler/src/Reporting/Error/Syntax.hs | 35 ------------- gren.cabal | 1 + tests/Parse/UnderscorePatternSpec.hs | 70 ++++++++++++++++++++++++++ 5 files changed, 92 insertions(+), 45 deletions(-) create mode 100644 tests/Parse/UnderscorePatternSpec.hs diff --git a/compiler/src/Parse/Pattern.hs b/compiler/src/Parse/Pattern.hs index be1d6e0c..3351b85d 100644 --- a/compiler/src/Parse/Pattern.hs +++ b/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 diff --git a/compiler/src/Parse/Variable.hs b/compiler/src/Parse/Variable.hs index a5f17492..6f63d6ff 100644 --- a/compiler/src/Parse/Variable.hs +++ b/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 diff --git a/compiler/src/Reporting/Error/Syntax.hs b/compiler/src/Reporting/Error/Syntax.hs index fae51b24..d36f22c6 100644 --- a/compiler/src/Reporting/Error/Syntax.hs +++ b/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 -> diff --git a/gren.cabal b/gren.cabal index 69be64d4..1efca928 100644 --- a/gren.cabal +++ b/gren.cabal @@ -243,6 +243,7 @@ Test-Suite gren-tests -- tests Parse.SpaceSpec Parse.RecordUpdateSpec + Parse.UnderscorePatternSpec Build-Depends: hspec >= 2.7.10 && < 3 diff --git a/tests/Parse/UnderscorePatternSpec.hs b/tests/Parse/UnderscorePatternSpec.hs new file mode 100644 index 00000000..146093f6 --- /dev/null +++ b/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