tricu

commit 962a100f533a1540d5c69c9b578ea998b52889e8
parent 56f0c2860a768820fca471e747d5a24bbc994dab
Author: James Eversole <james@eversole.co>
Date:   Tue, 21 Jan 2025 14:21:47 -0600

Inline pattern matching in Parser

Diffstat:
M
src/Parser.hs
 | 
96
++++++++++++++++++++++++++++++++++++-------------------------------------------
M
tricu.cabal
 | 
2
++

2 files changed, 46 insertions(+), 52 deletions(-)
diff --git a/src/Parser.hs b/src/Parser.hs
@@ -73,12 +73,14 @@ parseOneExpression = scnParserM *> parseExpressionM
 
 scnParserM :: ParserM ()
 scnParserM = skipMany $ do
-  t <- lookAhead anySingle
+  t  <- lookAhead anySingle
   st <- get
-  if depth st > 0 && isNewline t
-    then void (satisfyM isNewline)
-    else
-      fail "In paren context or no space token" <|> empty
+  if | depth st > 0 && case t of
+         LNewline -> True
+         _        -> False -> void $ satisfyM $ \case
+           LNewline -> True
+           _        -> False
+     | otherwise -> fail "In paren context or no space token" <|> empty
 
 eofM :: ParserM ()
 eofM = lift eof
@@ -96,23 +98,32 @@ parseExpressionM = choice
 
 parseFunctionM :: ParserM TricuAST
 parseFunctionM = do
-  LIdentifier name <- satisfyM isIdentifier
-  args <- many (satisfyM isIdentifier)
+  LIdentifier name <- satisfyM $ \case
+    LIdentifier _ -> True
+    _             -> False
+  args <- many $ satisfyM $ \case
+    LIdentifier _ -> True
+    _             -> False
   _    <- satisfyM (== LAssign)
   scnParserM
   body <- parseExpressionM
   pure (SFunc name (map getIdentifier args) body)
 
 parseLambdaM :: ParserM TricuAST
-parseLambdaM = between (satisfyM (== LOpenParen)) (satisfyM (== LCloseParen)) $ do
-  _       <- satisfyM (== LBackslash)
-  param   <- satisfyM isIdentifier
-  rest    <- many (satisfyM isIdentifier)
-  _       <- satisfyM (== LColon)
-  scnParserM
-  body    <- parseLambdaExpressionM
-  let nested = foldr (\v acc -> SLambda [getIdentifier v] acc) body rest
-  pure (SLambda [getIdentifier param] nested)
+parseLambdaM =
+  between (satisfyM (== LOpenParen)) (satisfyM (== LCloseParen)) $ do
+    _     <- satisfyM (== LBackslash)
+    param <- satisfyM $ \case
+      LIdentifier _ -> True
+      _             -> False
+    rest  <- many $ satisfyM $ \case
+      LIdentifier _ -> True
+      _             -> False
+    _     <- satisfyM (== LColon)
+    scnParserM
+    body <- parseLambdaExpressionM
+    let nested = foldr (\v acc -> SLambda [getIdentifier v] acc) body rest
+    pure (SLambda [getIdentifier param] nested)
 
 parseLambdaExpressionM :: ParserM TricuAST
 parseLambdaExpressionM = choice
@@ -158,8 +169,10 @@ parseAtomicBaseM = choice
 
 parseTreeLeafM :: ParserM TricuAST
 parseTreeLeafM = do
-  _ <- satisfyM isKeywordT
-  notFollowedBy (lift (satisfy (== LAssign)))
+  _ <- satisfyM $ \case
+    LKeywordT -> True
+    _         -> False
+  notFollowedBy $ lift $ satisfy (== LAssign)
   pure TLeaf
 
 parseTreeTermM :: ParserM TricuAST
@@ -221,7 +234,10 @@ parseGroupedItemM = do
 
 parseSingleItemM :: ParserM TricuAST
 parseSingleItemM = do
-  token <- satisfyM isListItem
+  token <- satisfyM $ \case
+    LIdentifier _ -> True
+    LKeywordT     -> True
+    _             -> False
   case token of
     LIdentifier name -> pure (SVar name)
     LKeywordT        -> pure TLeaf
@@ -229,51 +245,27 @@ parseSingleItemM = do
 
 parseVarM :: ParserM TricuAST
 parseVarM = do
-  LIdentifier name <- satisfyM isIdentifier
+  LIdentifier name <- satisfyM $ \case
+    LIdentifier _ -> True
+    _             -> False
   if name == "t" || name == "__result"
     then fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
     else pure (SVar name)
 
 parseIntLiteralM :: ParserM TricuAST
 parseIntLiteralM = do
-  LIntegerLiteral value <- satisfyM isIntegerLiteral
+  LIntegerLiteral value <- satisfyM $ \case
+    LIntegerLiteral _ -> True
+    _                 -> False
   pure (SInt value)
 
 parseStrLiteralM :: ParserM TricuAST
 parseStrLiteralM = do
-  LStringLiteral value <- satisfyM isStringLiteral
+  LStringLiteral value <- satisfyM $ \case 
+    LStringLiteral _ -> True
+    _ -> False
   pure (SStr value)
 
-isKeywordT :: LToken -> Bool
-isKeywordT LKeywordT = True
-isKeywordT _         = False
-
-isIdentifier :: LToken -> Bool
-isIdentifier (LIdentifier _) = True
-isIdentifier _               = False
-
-isIntegerLiteral :: LToken -> Bool
-isIntegerLiteral (LIntegerLiteral _) = True
-isIntegerLiteral _                   = False
-
-isStringLiteral :: LToken -> Bool
-isStringLiteral (LStringLiteral _)   = True
-isStringLiteral _                    = False
-
-isLiteral :: LToken -> Bool
-isLiteral (LIntegerLiteral _) = True
-isLiteral (LStringLiteral _)  = True
-isLiteral _                   = False
-
-isListItem :: LToken -> Bool
-isListItem (LIdentifier _) = True
-isListItem LKeywordT       = True
-isListItem _               = False
-
-isNewline :: LToken -> Bool
-isNewline LNewline = True
-isNewline _        = False
-
 getIdentifier :: LToken -> String
 getIdentifier (LIdentifier name) = name
 getIdentifier _                  = error "Expected identifier"
diff --git a/tricu.cabal b/tricu.cabal
@@ -18,6 +18,7 @@ executable tricu
       src
   default-extensions:
       DeriveDataTypeable
+      LambdaCase
       MultiWayIf
       OverloadedStrings
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
@@ -44,6 +45,7 @@ test-suite tricu-tests
   hs-source-dirs:      test, src
   default-extensions:
       DeriveDataTypeable
+      LambdaCase
       MultiWayIf
       OverloadedStrings
   build-depends: