named subpatterns

src/Juvix/Compiler/Core/Language/Nodes.hs

@@ -116,8 +116,9 @@ newtype PatternWildcard' i = PatternWildcard
   { _patternWildcardInfo :: i
   }
 
-newtype PatternBinder' i = PatternBinder
-  { _patternBinderInfo :: i
+data PatternBinder' i = PatternBinder
+  { _patternBinderInfo :: i,
+    _patternBinderPattern :: Pattern' i
   }
 
 data PatternConstr' i = PatternConstr
@@ -276,7 +277,7 @@ instance Eq (PatternWildcard' i) where
   _ == _ = True
 
 instance Eq (PatternBinder' i) where
-  _ == _ = True
+  (PatternBinder _ p1) == (PatternBinder _ p2) = p1 == p2
 
 instance Eq (PatternConstr' i) where
   (PatternConstr _ tag1 ps1) == (PatternConstr _ tag2 ps2) = tag1 == tag2 && ps1 == ps2

src/Juvix/Compiler/Core/Pretty/Base.hs

@@ -157,10 +157,15 @@ instance PrettyCode PatternWildcard where
   ppCode _ = return kwWildcard
 
 instance PrettyCode PatternBinder where
-  ppCode PatternBinder {..} =
-    case getInfoName _patternBinderInfo of
+  ppCode PatternBinder {..} = do
+    n <- case getInfoName _patternBinderInfo of
       Just name -> ppCode name
       Nothing -> return kwQuestion
+    case _patternBinderPattern of
+      PatWildcard {} -> return n
+      _ -> do
+        pat <- ppRightExpression appFixity _patternBinderPattern
+        return $ n <> kwAt <> pat
 
 instance PrettyCode PatternConstr where
   ppCode PatternConstr {..} = do
@@ -367,6 +372,9 @@ ppLRExpression associates fixlr e =
 {--------------------------------------------------------------------------------}
 {- keywords -}
 
+kwAt :: Doc Ann
+kwAt = delimiter "@"
+
 kwSquareL :: Doc Ann
 kwSquareL = delimiter "["
 

src/Juvix/Compiler/Core/Translation/FromSource.hs

@@ -783,7 +783,7 @@ branchPattern ::
   ParsecS r Pattern
 branchPattern =
   wildcardPattern
-    <|> binderOrConstrPattern
+    <|> binderOrConstrPattern True
     <|> parens branchPattern
 
 wildcardPattern :: ParsecS r Pattern
@@ -793,16 +793,28 @@ wildcardPattern = do
 
 binderOrConstrPattern ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Bool ->
   ParsecS r Pattern
-binderOrConstrPattern = do
+binderOrConstrPattern parseArgs = do
   (txt, i) <- identifierL
   r <- lift (getIdent txt)
   case r of
     Just (IdentTag tag) -> do
-      ps <- P.many branchPattern
+      ps <- if parseArgs then P.many branchPattern else return []
       ci <- lift $ getConstructorInfo tag
       let info = setInfoName (ci ^. constructorName) Info.empty
       return $ PatConstr (PatternConstr info tag ps)
     _ -> do
       n <- lift $ freshName KNameLocal txt i
-      return $ PatBinder (PatternBinder (setInfoName n Info.empty))
+      mp <- optional binderPattern
+      let pat = fromMaybe (PatWildcard (PatternWildcard Info.empty)) mp
+      return $ PatBinder (PatternBinder (setInfoName n Info.empty) pat)
+
+binderPattern ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r Pattern
+binderPattern = do
+  kwAt
+  wildcardPattern
+    <|> binderOrConstrPattern False
+    <|> parens branchPattern

src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs

@@ -54,6 +54,7 @@ allKeywords :: [ParsecS r ()]
 allKeywords =
   [ kwAssignment,
     kwColon,
+    kwAt,
     kwLambda,
     kwLet,
     kwLetRec,
@@ -169,6 +170,9 @@ kwComma = keyword Str.comma
 kwWildcard :: ParsecS r ()
 kwWildcard = keyword Str.underscore
 
+kwAt :: ParsecS r ()
+kwAt = keyword Str.at_
+
 kwPlus :: ParsecS r ()
 kwPlus = keyword Str.plus
 

src/Juvix/Extra/Strings.hs

@@ -200,6 +200,9 @@ semicolon = ";"
 underscore :: IsString s => s
 underscore = "_"
 
+at_ :: IsString s => s
+at_ = "@"
+
 colon :: IsString s => s
 colon = ":"
 

src/Juvix/Parser/Lexer.hs

@@ -100,7 +100,7 @@ delimiterSymbols :: [Char]
 delimiterSymbols = ","
 
 reservedSymbols :: [Char]
-reservedSymbols = "\";(){}[].≔λ\\"
+reservedSymbols = "@\";(){}[].≔λ\\"
 
 validFirstChar :: Char -> Bool
 validFirstChar c = not (isNumber c || isSpace c || (c `elem` reservedSymbols))