commit b0b0fb22b9024ac87ea0a00b47cca4c345bb9ded
parent 6713b05872f60c65c7c27700588f44e2edbd4e6b
Author: James Eversole <james@eversole.co>
Date: Sun, 26 Jan 2025 08:52:28 -0600
Allow lambda expressions without explicit paren
Diffstat:
9 files changed, 63 insertions(+), 87 deletions(-)
diff --git a/README.md b/README.md
@@ -2,7 +2,7 @@
## 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)`.
diff --git a/demos/equality.tri b/demos/equality.tri
@@ -6,7 +6,7 @@ demo_true = t t
not_TC? = t (t (t t) (t t t)) (t t (t t t))
-- /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
of
(\_ : ot)
diff --git a/demos/levelOrderTraversal.tri b/demos/levelOrderTraversal.tri
@@ -17,9 +17,9 @@
-- 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))
[]
@@ -39,7 +39,7 @@ processLevel = y (\self queue : if (emptyList? queue)
(\node : not? (emptyList? node))
(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)
""
@@ -47,11 +47,11 @@ toLineString = y (\self levels : if (emptyList? levels)
(lconcat (map (\x : lconcat x " ") (head 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) ""
-levelOrderTraversal = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
+levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s))
exampleOne = levelOrderTraversal [("1")
[("2") [("4") t t] t]
diff --git a/demos/size.tri b/demos/size.tri
@@ -1,4 +1,4 @@
-compose = (\f g x : f (g x))
+compose = \f g x : f (g x)
succ = y (\self :
triage
diff --git a/demos/toSource.tri b/demos/toSource.tri
@@ -40,7 +40,7 @@ toSource_ = y (\self arg :
arg) -- The term to be inspected
-- toSource takes a single TC term and returns a String
-toSource = (\v : toSource_ v "")
+toSource = \v : toSource_ v ""
exampleOne = toSource true -- OUT: "(t t)"
exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))"
diff --git a/lib/base.tri b/lib/base.tri
@@ -7,15 +7,15 @@ s = t (t (k t)) t
m = s i i
b = s (k s) k
c = s (s (k s) (s (k k) s)) (k k)
-id = (\a : a)
+id = \a : a
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)))
(\x : x x)
(\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")
matchBool = (\ot of : triage
@@ -24,17 +24,9 @@ matchBool = (\ot of : triage
(\_ _ : ot)
)
-matchList = (\oe oc : triage
- oe
- _
- oc
-)
+matchList = \a b : triage a _ b
-matchPair = (\op : triage
- _
- _
- op
-)
+matchPair = \a : triage _ _ a
not? = matchBool false true
and? = matchBool id (\_ : false)
@@ -50,20 +42,18 @@ lconcat = y (\self : matchList
lAnd = (triage
(\_ : false)
(\_ x : x)
- (\_ _ x : x)
-)
+ (\_ _ x : x))
lOr = (triage
(\x : x)
(\_ _ : true)
- (\_ _ _ : true)
-)
+ (\_ _ _ : true))
map_ = y (\self :
matchList
(\_ : t)
(\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
(triage
@@ -84,10 +74,10 @@ equal? = y (\self : triage
filter_ = y (\self : matchList
(\_ : t)
(\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 = (\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 = (\f x l : foldr_ x f l)
+foldr = \f x l : foldr_ x f l
diff --git a/src/Eval.hs b/src/Eval.hs
@@ -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
diff --git a/src/Parser.hs b/src/Parser.hs
@@ -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
diff --git a/tricu.cabal b/tricu.cabal
@@ -1,7 +1,7 @@
cabal-version: 1.12
name: tricu
-version: 0.7.0
+version: 0.9.0
description: A micro-language for exploring Tree Calculus
author: James Eversole
maintainer: james@eversole.co
