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

@ -2,7 +2,7 @@
## Introduction ## Introduction
tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool. tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool. tricu is under active development and you can expect breaking changes with nearly every commit.
tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`. tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.

View File

@ -6,7 +6,7 @@ demo_true = t t
not_TC? = t (t (t t) (t t t)) (t t (t t t)) not_TC? = t (t (t t) (t t t)) (t t (t t t))
-- /demos/toSource.tri contains an explanation of `triage` -- /demos/toSource.tri contains an explanation of `triage`
demo_triage = (\a b c : t (t a b) c) demo_triage = \a b c : t (t a b) c
demo_matchBool = (\ot of : demo_triage demo_matchBool = (\ot of : demo_triage
of of
(\_ : ot) (\_ : ot)

View File

@ -17,9 +17,9 @@
-- 4 5 6 -- 4 5 6
-- --
label = (\node : head node) label = \node : head node
left = (\node : if (emptyList? node) left = (\node : if (emptyList? node)
[] []
(if (emptyList? (tail node)) (if (emptyList? (tail node))
[] []
@ -39,7 +39,7 @@ processLevel = y (\self queue : if (emptyList? queue)
(\node : not? (emptyList? node)) (\node : not? (emptyList? node))
(lconcat (map left queue) (map right queue)))))) (lconcat (map left queue) (map right queue))))))
levelOrderTraversal_ = (\a : processLevel (t a t)) levelOrderTraversal_ = \a : processLevel (t a t)
toLineString = y (\self levels : if (emptyList? levels) toLineString = y (\self levels : if (emptyList? levels)
"" ""
@ -47,11 +47,11 @@ toLineString = y (\self levels : if (emptyList? levels)
(lconcat (map (\x : lconcat x " ") (head levels)) "") (lconcat (map (\x : lconcat x " ") (head levels)) "")
(if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels)))))) (if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
levelOrderToString = (\s : toLineString (levelOrderTraversal_ s)) levelOrderToString = \s : toLineString (levelOrderTraversal_ s)
flatten = foldl (\acc x : lconcat acc x) "" flatten = foldl (\acc x : lconcat acc x) ""
levelOrderTraversal = (\s : lconcat (t 10 t) (flatten (levelOrderToString s))) levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s))
exampleOne = levelOrderTraversal [("1") exampleOne = levelOrderTraversal [("1")
[("2") [("4") t t] t] [("2") [("4") t t] t]

View File

@ -1,4 +1,4 @@
compose = (\f g x : f (g x)) compose = \f g x : f (g x)
succ = y (\self : succ = y (\self :
triage triage

View File

@ -40,7 +40,7 @@ toSource_ = y (\self arg :
arg) -- The term to be inspected arg) -- The term to be inspected
-- toSource takes a single TC term and returns a String -- toSource takes a single TC term and returns a String
toSource = (\v : toSource_ v "") toSource = \v : toSource_ v ""
exampleOne = toSource true -- OUT: "(t t)" exampleOne = toSource true -- OUT: "(t t)"
exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))" exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))"

View File

@ -7,15 +7,15 @@ s = t (t (k t)) t
m = s i i m = s i i
b = s (k s) k b = s (k s) k
c = s (s (k s) (s (k k) s)) (k k) c = s (s (k s) (s (k k) s)) (k k)
id = (\a : a) id = \a : a
pair = t pair = t
if = (\cond then else : t (t else (t t then)) t cond) if = \cond then else : t (t else (t t then)) t cond
y = ((\mut wait fun : wait mut (\x : fun (wait mut x))) y = ((\mut wait fun : wait mut (\x : fun (wait mut x)))
(\x : x x) (\x : x x)
(\a0 a1 a2 : t (t a0) (t t a2) a1)) (\a0 a1 a2 : t (t a0) (t t a2) a1))
triage = (\leaf stem fork : t (t leaf stem) fork) triage = \leaf stem fork : t (t leaf stem) fork
test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork") test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
matchBool = (\ot of : triage matchBool = (\ot of : triage
@ -24,17 +24,9 @@ matchBool = (\ot of : triage
(\_ _ : ot) (\_ _ : ot)
) )
matchList = (\oe oc : triage matchList = \a b : triage a _ b
oe
_
oc
)
matchPair = (\op : triage matchPair = \a : triage _ _ a
_
_
op
)
not? = matchBool false true not? = matchBool false true
and? = matchBool id (\_ : false) and? = matchBool id (\_ : false)
@ -50,20 +42,18 @@ lconcat = y (\self : matchList
lAnd = (triage lAnd = (triage
(\_ : false) (\_ : false)
(\_ x : x) (\_ x : x)
(\_ _ x : x) (\_ _ x : x))
)
lOr = (triage lOr = (triage
(\x : x) (\x : x)
(\_ _ : true) (\_ _ : true)
(\_ _ _ : true) (\_ _ _ : true))
)
map_ = y (\self : map_ = y (\self :
matchList matchList
(\_ : t) (\_ : t)
(\head tail f : pair (f head) (self tail f))) (\head tail f : pair (f head) (self tail f)))
map = (\f l : map_ l f) map = \f l : map_ l f
equal? = y (\self : triage equal? = y (\self : triage
(triage (triage
@ -84,10 +74,10 @@ equal? = y (\self : triage
filter_ = y (\self : matchList filter_ = y (\self : matchList
(\_ : t) (\_ : t)
(\head tail f : matchBool (t head) i (f head) (self tail f))) (\head tail f : matchBool (t head) i (f head) (self tail f)))
filter = (\f l : filter_ l f) filter = \f l : filter_ l f
foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x) foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
foldl = (\f x l : foldl_ f l x) foldl = \f x l : foldl_ f l x
foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l) foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
foldr = (\f x l : foldr_ x f l) foldr = \f x l : foldr_ x f l

View File

@ -54,8 +54,6 @@ evalAST env term
(errorWithoutStackTrace $ "Variable " ++ name ++ " not defined") (errorWithoutStackTrace $ "Variable " ++ name ++ " not defined")
name env 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 :: TricuAST -> TricuAST
elimLambda = go elimLambda = go
where where
@ -68,9 +66,9 @@ elimLambda = go
where where
triageBody = triageBody =
(SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c)) (SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c))
-- Compose optimization -- Composition optimization
go (SLambda [f] (SLambda [g] (SLambda [x] body))) go (SLambda [f] (SLambda [g] (SLambda [x] body)))
| body == composeBody = _COMPOSE | body == composeBody = _COMPOSE
where where
composeBody = SApp (SVar f) (SApp (SVar g) (SVar x)) composeBody = SApp (SVar f) (SApp (SVar g) (SVar x))
-- General elimination -- General elimination

View File

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

View File

@ -1,7 +1,7 @@
cabal-version: 1.12 cabal-version: 1.12
name: tricu name: tricu
version: 0.7.0 version: 0.9.0
description: A micro-language for exploring Tree Calculus description: A micro-language for exploring Tree Calculus
author: James Eversole author: James Eversole
maintainer: james@eversole.co maintainer: james@eversole.co