Allow lambda expressions without explicit paren
All checks were successful
Test, Build, and Release / test (push) Successful in 1m41s
Test, Build, and Release / build (push) Successful in 1m19s

This commit is contained in:
James Eversole
2025-01-26 08:52:28 -06:00
parent ea128929da
commit e2621bc09d
9 changed files with 63 additions and 87 deletions

View File

@ -54,8 +54,6 @@ evalAST env term
(errorWithoutStackTrace $ "Variable " ++ name ++ " not defined")
name env
-- https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf
-- Chapter 4: Lambda-Abstraction
elimLambda :: TricuAST -> TricuAST
elimLambda = go
where
@ -68,9 +66,9 @@ elimLambda = go
where
triageBody =
(SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c))
-- Compose optimization
-- Composition optimization
go (SLambda [f] (SLambda [g] (SLambda [x] body)))
| body == composeBody = _COMPOSE
| body == composeBody = _COMPOSE
where
composeBody = SApp (SVar f) (SApp (SVar g) (SVar x))
-- General elimination

View File

@ -85,13 +85,10 @@ scnParserM :: ParserM ()
scnParserM = skipMany $ do
t <- lookAhead anySingle
st <- get
if | (parenDepth st > 0 || bracketDepth st > 0) && case t of
LNewline -> True
_ -> False -> void $ satisfyM $ \case
LNewline -> True
_ -> False
| otherwise -> fail "In nested context or no space token" <|> empty
if | (parenDepth st > 0 || bracketDepth st > 0) && (t == LNewline) ->
void $ satisfyM (== LNewline)
| otherwise ->
fail "In nested context or no space token" <|> empty
eofM :: ParserM ()
eofM = lift eof
@ -109,32 +106,23 @@ parseExpressionM = choice
parseFunctionM :: ParserM TricuAST
parseFunctionM = do
LIdentifier name <- satisfyM $ \case
LIdentifier _ -> True
_ -> False
args <- many $ satisfyM $ \case
LIdentifier _ -> True
_ -> False
let ident = (\case LIdentifier _ -> True; _ -> False)
LIdentifier name <- satisfyM ident
args <- many $ satisfyM ident
_ <- 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 $ \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)
parseLambdaM = do
let ident = (\case LIdentifier _ -> True; _ -> False)
_ <- satisfyM (== LBackslash)
params <- some (satisfyM ident)
_ <- satisfyM (== LColon)
scnParserM
body <- parseLambdaExpressionM
pure $ foldr (\param acc -> SLambda [getIdentifier param] acc) body params
parseLambdaExpressionM :: ParserM TricuAST
parseLambdaExpressionM = choice
@ -180,9 +168,8 @@ parseAtomicBaseM = choice
parseTreeLeafM :: ParserM TricuAST
parseTreeLeafM = do
_ <- satisfyM $ \case
LKeywordT -> True
_ -> False
let keyword = (\case LKeywordT -> True; _ -> False)
_ <- satisfyM keyword
notFollowedBy $ lift $ satisfy (== LAssign)
pure TLeaf
@ -248,37 +235,38 @@ parseGroupedItemM = do
parseSingleItemM :: ParserM TricuAST
parseSingleItemM = do
token <- satisfyM $ \case
LIdentifier _ -> True
LKeywordT -> True
_ -> False
case token of
LIdentifier name -> pure (SVar name)
LKeywordT -> pure TLeaf
_ -> fail "Unexpected token in list item"
token <- satisfyM (\case LIdentifier _ -> True; LKeywordT -> True; _ -> False)
if | LIdentifier name <- token -> pure (SVar name)
| token == LKeywordT -> pure TLeaf
| otherwise -> fail "Unexpected token in list item"
parseVarM :: ParserM TricuAST
parseVarM = do
LIdentifier name <- satisfyM $ \case
LIdentifier _ -> True
_ -> False
if name == "t" || name == "__result"
then fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
else pure (SVar name)
satisfyM (\case LIdentifier _ -> True; _ -> False) >>= \case
LIdentifier name
| name == "t" || name == "__result" ->
fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
| otherwise ->
pure (SVar name)
_ -> fail "Unexpected token while parsing variable"
parseIntLiteralM :: ParserM TricuAST
parseIntLiteralM = do
LIntegerLiteral value <- satisfyM $ \case
LIntegerLiteral _ -> True
_ -> False
pure (SInt value)
let intL = (\case LIntegerLiteral _ -> True; _ -> False)
token <- satisfyM intL
if | LIntegerLiteral value <- token ->
pure (SInt value)
| otherwise ->
fail "Unexpected token while parsing integer literal"
parseStrLiteralM :: ParserM TricuAST
parseStrLiteralM = do
LStringLiteral value <- satisfyM $ \case
LStringLiteral _ -> True
_ -> False
pure (SStr value)
let strL = (\case LStringLiteral _ -> True; _ -> False)
token <- satisfyM strL
if | LStringLiteral value <- token ->
pure (SStr value)
| otherwise ->
fail "Unexpected token while parsing string literal"
getIdentifier :: LToken -> String
getIdentifier (LIdentifier name) = name