Allow lambda expressions without explicit paren
This commit is contained in:
parent
ea128929da
commit
e2621bc09d
@ -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)`.
|
||||||
|
|
||||||
|
@ -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)
|
||||||
|
@ -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]
|
||||||
|
@ -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
|
||||||
|
@ -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)))"
|
||||||
|
32
lib/base.tri
32
lib/base.tri
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user