diff --git a/README.md b/README.md index 44a6342..12eb641 100644 --- 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 index 9c8d5c8..efbfabe 100644 --- 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 index 0ad3b4f..179e300 100644 --- 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 index 55743c9..dde6d66 100644 --- 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 index e686cc3..e2fb054 100644 --- 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 index b3e27ae..58bb07a 100644 --- 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 index 2664739..f49866d 100644 --- 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 index 02dea23..9178bdd 100644 --- 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 index bc340f8..c4a352f 100644 --- 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